Subversion Repositories recyclebinunit

Rev

Rev 75 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit SIDUnit;
  2.  
  3. // This unit helps you to find out your SID.
  4. // It is compatible with all Windows versions down to Win95!
  5. // (On Win9x, the result string is empty, of course)
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, SysUtils;
  11.  
  12. type
  13.   EAPICallError = class(Exception);
  14.  
  15. function GetMySID: string;
  16.  
  17. implementation
  18.  
  19. // **********************************************************
  20. // INTERNALLY USED FUNCTIONS
  21. // **********************************************************
  22.  
  23. // http://www.delphipraxis.net/post471470.html
  24. function _getAccountSid(const Server, User: WideString; var Sid: PSID): DWORD;
  25. var
  26.   dwDomainSize, dwSidSize: DWord;
  27.   R: LongBool;
  28.   wDomain: WideString;
  29.   Use: DWord;
  30. begin
  31.   Result := 0;
  32.   SetLastError(0);
  33.   dwSidSize := 0;
  34.   dwDomainSize := 0;
  35.   R := LookupAccountNameW(PWideChar(Server), PWideChar(User), nil, dwSidSize,
  36.        nil, dwDomainSize, Use);
  37.   if (not R) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
  38.   begin
  39.     SetLength(wDomain, dwDomainSize);
  40.     Sid := GetMemory(dwSidSize);
  41.     R := LookupAccountNameW(PWideChar(Server), PWideChar(User), Sid,
  42.          dwSidSize, PWideChar(wDomain), dwDomainSize, Use);
  43.     if not R then
  44.     begin
  45.       FreeMemory(Sid);
  46.       Sid := nil;
  47.     end;
  48.   end
  49.   else
  50.     Result := GetLastError;
  51. end;
  52.  
  53. const
  54.   UNLEN = 256; // lmcons.h
  55.  
  56. // Template:
  57. // http://www.latiumsoftware.com/en/pascal/0014.php
  58. function _getLoginNameW: widestring;
  59. var
  60.   Buffer: array[0..UNLEN] of widechar;
  61.   Size: DWORD;
  62. begin
  63.   Size := SizeOf(Buffer);
  64.   if GetUserNameW(Buffer, Size) then
  65.     Result := Buffer
  66.   else
  67.     Result := 'User';
  68. end;
  69.  
  70. function _ConvertSidToStringSidA(SID: PSID; var strSID: LPSTR): boolean;
  71. type
  72.   DllReg = function(SID: PSID; var StringSid: LPSTR): Boolean; stdcall;
  73. var
  74.   hDll: THandle;
  75.   dr: DllReg;
  76. begin
  77.   result := false;
  78.   hDll := LoadLibrary(advapi32);
  79.   if hDll <> 0 then
  80.   begin
  81.     @dr := GetProcAddress(hDll, 'ConvertSidToStringSidA');
  82.  
  83.     if assigned(dr) then
  84.     begin
  85.       result := dr(SID, strSID);
  86.     end;
  87.   end;
  88. end;
  89.  
  90. const
  91.   winternl_lib = 'Ntdll.dll';
  92.  
  93. type
  94.   USHORT = Word;
  95.   PWSTR = PWidechar;
  96.   PCWSTR = PWideChar;
  97.  
  98.    NTSTATUS = Longword;
  99.  
  100.   _UNICODE_STRING = record
  101.     Length: USHORT;
  102.     MaximumLength: USHORT;
  103.     Buffer: PWSTR;
  104.   end;
  105.   UNICODE_STRING = _UNICODE_STRING;
  106.   PUNICODE_STRING = ^UNICODE_STRING;
  107.  
  108. function _RtlConvertSidToUnicodeString(
  109.   UnicodeString: PUNICODE_STRING;
  110.   Sid: PSID;
  111.   AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
  112. type
  113.   DllReg = function(UnicodeString: PUNICODE_STRING;
  114.   Sid: PSID;
  115.   AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
  116. var
  117.   hDll: THandle;
  118.   dr: DllReg;
  119. begin
  120.   result := $FFFFFFFF;
  121.   hDll := LoadLibrary(winternl_lib);
  122.   if hDll = 0 then Exit;
  123.   try
  124.     @dr := GetProcAddress(hDll, 'RtlConvertSidToUnicodeString');
  125.     if not Assigned(dr) then Exit;
  126.     result := dr(UnicodeString, Sid, AllocateDestinationString);
  127.   finally
  128.     FreeLibrary(hDll);
  129.   end;
  130. end;
  131.  
  132. procedure _RtlFreeUnicodeString(UnicodeString: PUNICODE_STRING); stdcall;
  133. type
  134.   DllReg = procedure(UnicodeString: PUNICODE_STRING); stdcall;
  135. var
  136.   hDll: THandle;
  137.   dr: DllReg;
  138. begin
  139.   hDll := LoadLibrary(winternl_lib);
  140.   if hDll = 0 then Exit;
  141.   try
  142.     @dr := GetProcAddress(hDll, 'RtlFreeUnicodeString');
  143.     if not Assigned(dr) then Exit;
  144.     dr(UnicodeString);
  145.   finally
  146.     FreeLibrary(hDll);
  147.   end;
  148. end;
  149.  
  150. function _NT_SidToString(SID: PSID; var strSID: string): boolean;
  151. var
  152.   pus: PUNICODE_STRING;
  153.   us: UNICODE_STRING;
  154. begin
  155.   pus := @us;
  156.   result := _RtlConvertSidToUnicodeString(pus, SID, true) = 0;
  157.   if not result then Exit;
  158.   strSID := pus^.Buffer;
  159.   UniqueString(strSID);
  160.   _RtlFreeUnicodeString(pus);
  161.   result := true;
  162. end;
  163.  
  164. // Source: http://www.delphipraxis.net/post471470.html
  165. // Modified
  166. function GetMySID(): string;
  167. var
  168.   SID: PSID;
  169.   strSID: PAnsiChar;
  170.   err: DWORD;
  171. begin
  172.   SID := nil;
  173.  
  174.   err := _getAccountSid('', _getLoginNameW(), SID);
  175.   try
  176.     if err > 0 then
  177.     begin
  178.       EAPICallError.Create('_getAccountSid:' + SysErrorMessage(err));
  179.       Exit;
  180.     end;
  181.  
  182.     if _ConvertSidToStringSidA(SID, strSID) then
  183.     begin
  184.       result := string(strSID);
  185.       Exit;
  186.     end;
  187.  
  188.     if not _NT_SidToString(SID, result) then
  189.     begin
  190.       EAPICallError.Create('_NT_SidToString'); // TODO: RaiseLastOsError???
  191.     end;
  192.   finally
  193.     if Assigned(SID) then FreeMemory(SID);
  194.   end;
  195. end;
  196.  
  197. end.
  198.