Subversion Repositories userdetect2

(******************************************************************************)

(* SPGetSid - Retrieve the current user's SID in text format                  *)

(*                                                                            *)

(* Copyright (c) 2004 Shorter Path Software                                   *)

(* http://www.shorterpath.com                                                 *)

(******************************************************************************)

            (*** Modified and extended by ViaThinkSoft ***)

{

  SID is a data structure of variable length that identifies user, group,

  and computer accounts.

  Every account on a network is issued a unique SID when the account is first created.

  Internal processes in Windows refer to an account's SID

  rather than the account's user or group name.

}

unit SPGetSid;

interface

uses

  Windows, SysUtils;

function GetCurrentUserSid: string;

function GetComputerSID: string;

implementation

const

  HEAP_ZERO_MEMORY = $00000008;

  SID_REVISION     = 1; // Current revision level

type

  PTokenUser = ^TTokenUser;

  TTokenUser = packed record

    User: TSidAndAttributes;

  end;

function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;

var

  psia: PSIDIdentifierAuthority;

  dwSubAuthorities: DWORD;

  dwSidRev: DWORD;

  dwCounter: DWORD;

  dwSidSize: DWORD;

begin

  Result := False;

  dwSidRev := SID_REVISION;

  if not IsValidSid(Sid) then Exit;

  psia := GetSidIdentifierAuthority(Sid);

  dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;

  dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);

  if (dwBufferLen < dwSidSize) then

  begin

    dwBufferLen := dwSidSize;

    SetLastError(ERROR_INSUFFICIENT_BUFFER);

    Exit;

  end;

  StrFmt(pszSidText, 'S-%u-', [dwSidRev]);

  if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then

    StrFmt(pszSidText + StrLen(pszSidText),

      '0x%.2x%.2x%.2x%.2x%.2x%.2x',

      [psia.Value[0], psia.Value[1], psia.Value[2],

      psia.Value[3], psia.Value[4], psia.Value[5]])

  else

    StrFmt(pszSidText + StrLen(pszSidText),

      '%u',

      [DWORD(psia.Value[5]) +

      DWORD(psia.Value[4] shl 8) +

      DWORD(psia.Value[3] shl 16) +

      DWORD(psia.Value[2] shl 24)]);

  dwSidSize := StrLen(pszSidText);

  for dwCounter := 0 to dwSubAuthorities - 1 do

  begin

    StrFmt(pszSidText + dwSidSize, '-%u',

      [GetSidSubAuthority(Sid, dwCounter)^]);

    dwSidSize := StrLen(pszSidText);

  end;

  Result := True;

end;

function ObtainTextSid(hToken: THandle; pszSid: PChar; var dwBufferLen: DWORD): BOOL;

var

  dwReturnLength: DWORD;

  dwTokenUserLength: DWORD;

  tic: TTokenInformationClass;

  ptu: Pointer;

begin

  Result := False;

  dwReturnLength := 0;

  dwTokenUserLength := 0;

  tic := TokenUser;

  ptu := nil;

  if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,

    dwReturnLength) then

  begin

    if GetLastError = ERROR_INSUFFICIENT_BUFFER then

    begin

      ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);

      if ptu = nil then Exit;

      dwTokenUserLength := dwReturnLength;

      dwReturnLength    := 0;

      if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,

        dwReturnLength) then Exit;

    end

    else

      Exit;

  end;

  if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;

  if not HeapFree(GetProcessHeap, 0, ptu) then Exit;

  Result := True;

end;

function GetCurrentUserSid: string;

var

  hAccessToken: THandle;

  bSuccess: BOOL;

  dwBufferLen: DWORD;

  szSid: array[0..MAX_PATH] of Char;

begin

  Result := '';

  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,

    hAccessToken);

  if not bSuccess then

  begin

    if GetLastError = ERROR_NO_TOKEN then

      bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,

        hAccessToken);

  end;

  if bSuccess then

  begin

    ZeroMemory(@szSid, SizeOf(szSid));

    dwBufferLen := SizeOf(szSid);

    if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then

      Result := szSid;

    CloseHandle(hAccessToken);

  end;

end;

// --- Section added by ViaThinkSoft ---

function SIDToString(ASID: PSID): string;

  function _FallBack: string;

  var

    StringSid : PChar;

    len: DWORD;

  begin

    len := MAX_PATH;

    StringSid := AllocMem(MAX_PATH);

    ConvertSid(ASID, StringSid, len);

    Result := string(StringSid);

    FreeMem(StringSid);

  end;

type

  TFuncConvertSidToStringSid = function(Sid: PSID; out StringSid: PChar): BOOL; stdcall;

var

  dllHandle: HMODULE;

  fConvertSidToStringSid: TFuncConvertSidToStringSid;

  StringSid : PChar;

begin

  dllHandle := LoadLibrary(advapi32);

  if dllHandle = 0 then

  begin

    result := _FallBack;

    Exit;

  end;

  try

    @fConvertSidToStringSid := GetProcAddress(dllHandle, {$IFDEF UNICODE}'ConvertSidToStringSidW'{$ELSE}'ConvertSidToStringSidA'{$ENDIF});

    if not Assigned(fConvertSidToStringSid) then

    begin

      result := _FallBack;

      Exit;

    end;

    fConvertSidToStringSid(ASID, StringSid);

    Result := string(StringSid);

    LocalFree(HLocal(StringSid)); // added by ViaThinkSoft

  finally

    FreeLibrary(dllHandle);

  end;

end;

function GetComputerName: string;

// Source: http://www.delphi-treff.de/tipps-tricks/netzwerkinternet/netzwerkeigenschaften/computernamen-des-eigenen-rechners-ermitteln/

var

  Len: DWORD;

begin

  Len := MAX_COMPUTERNAME_LENGTH+1;

  SetLength(Result,Len);

  if Windows.GetComputerName(PChar(Result), Len) then

    SetLength(Result,Len)

  else

    RaiseLastOSError;

end;

function GetComputerSID: string;

// Source: http://stackoverflow.com/a/7643383

var

  Sid: PSID;

  cbSid: DWORD;

  cbReferencedDomainName : DWORD;

  ReferencedDomainName: string;

  peUse: SID_NAME_USE;

  Success: BOOL;

  lpSystemName : string;

  lpAccountName: string;

begin

  result := '';

  Sid:=nil;

  try

    lpSystemName:='';

    lpAccountName:=GetComputerName;

    cbSid := 0;

    cbReferencedDomainName := 0;

    // First call to LookupAccountName to get the buffer sizes.

    Success := LookupAccountName(PChar(lpSystemName), PChar(lpAccountName), nil, cbSid, nil, cbReferencedDomainName, peUse);

    if (not Success) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then

    begin

      SetLength(ReferencedDomainName, cbReferencedDomainName);

      Sid := AllocMem(cbSid);

      // Second call to LookupAccountName to get the SID.

      Success := LookupAccountName(PChar(lpSystemName), PChar(lpAccountName), Sid, cbSid, PChar(ReferencedDomainName), cbReferencedDomainName, peUse);

      if not Success then

      begin

        FreeMem(Sid);

        Sid := nil;

        RaiseLastOSError;

      end

      else

        Result := SIDToString(Sid);

    end

    else

      RaiseLastOSError;

  finally

    if Assigned(Sid) then

      FreeMem(Sid);

  end;

end;

end.