source: cprs/branches/HealthSevak-CPRS/BDK50/BDK32_P50/Source/XlfSid.pas@ 1711

unit XlfSid;
{ **************************************************************
        Package: XWB - Kernel RPCBroker
        Date Created: Sept 18, 1997 (Version 1.1)
        Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
        Developers: Danila Manapsal, Don Craven, Joel Ivey
        Description: Contains TRPCBroker and related components.
        Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
*************************************************************** }

//*******************************************************
//These functions get thier data from the Thread
// or Process security ID in Windows.
// GetNTLogonUser returns the Domain\Username that
//  authtcated the user/
// GetNTLogonSid returns a string with the users SID.
//********************************************************

interface

uses windows, SysUtils;
type  {From MSDN}

  StringSid = ^LPTSTR;

function ConvertSidToStringSid(Sid: {THandle}PSID; var StrSid: LPTSTR): BOOL stdcall;

function GetNTLogonUser(): string;
function GetNTLogonSid(): string;

implementation


function ConvertSidToStringSid; external advapi32 name 'ConvertSidToStringSidA';

function GetNTLogonUser(): string;
var
    hToken: THANDLE;
    tic: TTokenInformationClass;
    ptkUser:  PSIDAndAttributes;
    P: pointer;
    buf: PChar;
    cbti: DWORD;
    Name: PChar;
    cbName: DWORD;
    RDN: PChar;
    cbRDN: DWORD;
    snu: DWORD;
begin
    Result := '';
    tic := TokenUser;
    Name := '';
    RDN := '';

    try
    //Get the calling thread's access token
    if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY
                , longbool(true), hToken) then
         if (GetLastError() <> ERROR_NO_TOKEN) then exit
    // Retry against process token if no thread token exist.
          else
          if not OpenProcessToken(GetCurrentProcess()
                 ,TOKEN_QUERY, hToken) then exit;
    // Obtain the size of the user info in the token
    // Call should fail due to zero-length buffer
    if GetTokenInformation(hToken, tic, nil, 0, cbti) then exit;

    // Allocate buffer for user Info
    buf := StrAlloc(cbti);

    // Retrive the user info from the token.
    if not GetTokenInformation(hToken, tic, buf, cbti, cbti) then exit;
    cbName := 0;
    cbRDN := 0;
    snu := 0;
    P := buf;  //Use pointer to recast PChar
    ptkUser := PSIDAndAttributes(P);
    //call to get the size of name and RDN.
    LookupAccountSid( nil, ptkUser.Sid, Name, cbName
                            , RDN, cbRDN, snu);
    Name := StrAlloc(cbName);
    RDN := StrAlloc(cbRDN);
    //Call to fillin Name and RDN
    LookupAccountSid( nil, ptkUser.Sid, Name, cbName
                            , RDN, cbRDN, snu);
    Result := string(RDN) + '\' + string(Name);
    StrDispose(Name);
    StrDispose(RDN);
    finally
    if (hToken <> 0) then CloseHandle(hToken);
    end;

end;

function GetNTLogonSid(): string;
var
    hToken: THANDLE;
    tic: TTokenInformationClass;
    ptkUser:  PSIDAndAttributes;
    P: pointer;
    buf: PChar;
    StrSid: PChar;
    cbti: DWORD;
//    cbName: DWORD;
//    cbRDN: DWORD;
//    snu: DWORD;
begin
    Result := '';
    tic := TokenUser;

    try
    //Get the calling thread's access token
    if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY
                , longbool(true), hToken) then
         if (GetLastError() <> ERROR_NO_TOKEN) then exit
    // Retry against process token if no thread token exist.
          else
          if not OpenProcessToken(GetCurrentProcess()
                 ,TOKEN_QUERY, hToken) then exit;
    // Obtain the size of the user info in the token
    // Call should fail due to zero-length buffer
    if GetTokenInformation(hToken, tic, nil, 0, cbti) then exit;

    // Allocate buffer for user Info
    buf := StrAlloc(cbti);

    // Retrive the user info from the token.
    if not GetTokenInformation(hToken, tic, buf, cbti, cbti) then exit;
    P := buf;  //Use pointer to recast PChar
    ptkUser := PSIDAndAttributes(P);
//    P := nil;
    if ConvertSidToStringSid(ptkUser.sid, StrSid) = true then
        begin
        Result := PChar(StrSid);
        localFree(Cardinal(StrSid));
        end;
    finally
    if (hToken <> 0) then CloseHandle(hToken);
    end;

end;
end.