Этот блок определяет имя текущего Пользователя NT / 2000 Рабочей Станции / Сервера. Он взят из программы "loggedon2" Assarbad
и настроен для VCL. Этот блок содержит хотя еще некоторые небольшие ошибки, но работает без проблем.
Code: |
{-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - unit Name: GetUser Author: Manfred Ruzicka - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} unit GetUser;
interface
uses Windows , Messages , SysUtils , Dialogs;
type TServerBrowseDialogA0 = function(hwnd: HWND; pchBuffer: Pointer; cchBufSize: DWORD): bool; stdcall; ATStrings = array of string;
procedure Server(const ServerName: string); function ShowServerDialog(AHandle: THandle): string;
implementation
uses Client, ClientSkin;
procedure Server(const ServerName: string); const MAX_NAME_STRING = 1024; var userName, domainName: array[0..MAX_NAME_STRING] of Char; subKeyName: array[0..MAX_PATH] of Char; NIL_HANDLE: Integer absolute 0; Result: ATStrings; subKeyNameSize: DWORD; Index: DWORD; userNameSize: DWORD; domainNameSize: DWORD; lastWriteTime: FILETIME; usersKey: HKEY; sid: PSID; sidType: SID_NAME_USE; authority: SID_IDENTIFIER_AUTHORITY; subAuthorityCount: BYTE; authorityVal: DWORD; revision: DWORD; subAuthorityVal: array[0..7] of DWORD;
function getvals(s: string): Integer; var i, j, k, l: integer; tmp: string; begin Delete(s, 1, 2); j := Pos('-', s); tmp := Copy(s, 1, j - 1); val(tmp, revision, k); Delete(s, 1, j); j := Pos('-', s); tmp := Copy(s, 1, j - 1); val('$' + tmp, authorityVal, k); Delete(s, 1, j); i := 2; s := s + '-'; for l := 0 to 7 do begin j := Pos('-', s); if j > 0 then begin tmp := Copy(s, 1, j - 1); val(tmp, subAuthorityVal[l], k); Delete(s, 1, j); Inc(i); end else break; end; Result := i; end; begin setlength(Result, 0); revision := 0; authorityVal := 0; FillChar(subAuthorityVal, SizeOf(subAuthorityVal), #0); FillChar(userName, SizeOf(userName), #0); FillChar(domainName, SizeOf(domainName), #0); FillChar(subKeyName, SizeOf(subKeyName), #0); if ServerName <> '' then begin usersKey := 0; if (RegConnectRegistry(PChar(ServerName), HKEY_USERS, usersKey) <> 0) then Exit; end else begin if (RegOpenKey(HKEY_USERS, nil, usersKey) <> ERROR_SUCCESS) then Exit; end; Index := 0; subKeyNameSize := SizeOf(subKeyName); while (RegEnumKeyEx(usersKey, Index, subKeyName, subKeyNameSize, nil, nil, nil, @lastWriteTime) = ERROR_SUCCESS) do begin if (lstrcmpi(subKeyName, '.default') <> 0) and (Pos('Classes', string(subKeyName)) = 0) then begin subAuthorityCount := getvals(subKeyName); if (subAuthorityCount >= 3) then begin subAuthorityCount := subAuthorityCount - 2; if (subAuthorityCount < 2) then subAuthorityCount := 2; authority.Value[5] := PByte(@authorityVal)^; authority.Value[4] := PByte(DWORD(@authorityVal) + 1)^; authority.Value[3] := PByte(DWORD(@authorityVal) + 2)^; authority.Value[2] := PByte(DWORD(@authorityVal) + 3)^; authority.Value[1] := 0; authority.Value[0] := 0; sid := nil; userNameSize := MAX_NAME_STRING; domainNameSize := MAX_NAME_STRING; if AllocateAndInitializeSid(authority, subAuthorityCount, subAuthorityVal[0], subAuthorityVal[1], subAuthorityVal[2], subAuthorityVal[3], subAuthorityVal[4], subAuthorityVal[5], subAuthorityVal[6], subAuthorityVal[7], sid) then begin if LookupAccountSid(PChar(ServerName), sid, userName, userNameSize, domainName, domainNameSize, sidType) then begin setlength(Result, Length(Result) + 1); Result[Length(Result) - 1] := string(domainName) + '\' + string(userName);
// Hier kann das Ziel eingetragen werden Form1.label2.Caption := string(userName); form2.label1.Caption := string(userName); end; end; if Assigned(sid) then FreeSid(sid); end; end; subKeyNameSize := SizeOf(subKeyName); Inc(Index); end; RegCloseKey(usersKey); end;
function ShowServerDialog(AHandle: THandle): string; var ServerBrowseDialogA0: TServerBrowseDialogA0; LANMAN_DLL: DWORD; buffer: array[0..1024] of char; bLoadLib: Boolean; begin bLoadLib := False; LANMAN_DLL := GetModuleHandle('NTLANMAN.DLL'); if LANMAN_DLL = 0 then begin LANMAN_DLL := LoadLibrary('NTLANMAN.DLL'); bLoadLib := True; end; if LANMAN_DLL <> 0 then begin @ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, 'ServerBrowseDialogA0'); DialogBox(HInstance, MAKEINTRESOURCE(101), AHandle, nil); ServerBrowseDialogA0(AHandle, @buffer, 1024); if buffer[0] = '\' then begin Result := buffer; end; if bLoadLib = True then FreeLibrary(LANMAN_DLL); end; end;
end. |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!