david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
712 lines
25 KiB
ObjectPascal
712 lines
25 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclSecurity.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Marcel van Brakel. }
|
|
{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Marcel van Brakel }
|
|
{ Peter Friese }
|
|
{ Robert Marquardt (marquardt) }
|
|
{ John C Molyneux }
|
|
{ Robert Rossmair (rrossmair) }
|
|
{ Matthias Thoma (mthoma) }
|
|
{ Petr Vones (pvones) }
|
|
{ Christoph Lindeman }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Various NT security related routines to perform commen asks such as enabling and disabling }
|
|
{ privileges. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-08-09 15:08:29 +0200 (dim., 09 août 2009) $ }
|
|
{ Revision: $Rev:: 2921 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclSecurity;
|
|
|
|
{$I jcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
{$HPPEMIT '#define TTokenInformationClass TOKEN_INFORMATION_CLASS'}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, SysUtils,
|
|
JclBase;
|
|
|
|
type
|
|
EJclSecurityError = class(EJclError);
|
|
|
|
// Access Control
|
|
function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes;
|
|
function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes;
|
|
|
|
// Privileges
|
|
function IsAdministrator: Boolean;
|
|
function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean;
|
|
function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean;
|
|
function IsPrivilegeEnabled(const Privilege: string): Boolean;
|
|
|
|
function GetPrivilegeDisplayName(const PrivilegeName: string): string;
|
|
function SetUserObjectFullAccess(hUserObject: THandle): Boolean;
|
|
function GetUserObjectName(hUserObject: THandle): string;
|
|
|
|
// Account Information
|
|
procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString); overload;
|
|
procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString); overload;
|
|
procedure QueryTokenInformation(Token: THandle; InformationClass: TTokenInformationClass; var Buffer: Pointer);
|
|
procedure FreeTokenInformation(var Buffer: Pointer);
|
|
function GetInteractiveUserName: string;
|
|
|
|
// SID utilities
|
|
function SIDToString(ASID: PSID): string;
|
|
procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD);
|
|
|
|
// Computer Information
|
|
function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean;
|
|
|
|
// Windows Vista/Server 2008 UAC (User Account Control)
|
|
function IsUACEnabled: Boolean;
|
|
function IsElevated: Boolean;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/windows/JclSecurity.pas $';
|
|
Revision: '$Revision: 2921 $';
|
|
Date: '$Date: 2009-08-09 15:08:29 +0200 (dim., 09 août 2009) $';
|
|
LogPath: 'JCL\source\windows';
|
|
Extra: '';
|
|
Data: nil
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Classes,
|
|
{$IFDEF BORLAND}
|
|
AccCtrl,
|
|
{$ENDIF BORLAND}
|
|
JclRegistry, JclResources, JclStrings, JclSysInfo, JclWin32;
|
|
|
|
//=== Access Control =========================================================
|
|
|
|
function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
Sa.lpSecurityDescriptor := AllocMem(SizeOf(TSecurityDescriptor));
|
|
try
|
|
Sa.nLength := SizeOf(Sa);
|
|
Sa.bInheritHandle := Inheritable;
|
|
Win32Check(InitializeSecurityDescriptor(Sa.lpSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION));
|
|
Win32Check(SetSecurityDescriptorDacl(Sa.lpSecurityDescriptor, True, nil, False));
|
|
Result := @Sa;
|
|
except
|
|
FreeMem(Sa.lpSecurityDescriptor);
|
|
Sa.lpSecurityDescriptor := nil;
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Sa.lpSecurityDescriptor := nil;
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes;
|
|
begin
|
|
Sa.nLength := SizeOf(Sa);
|
|
Sa.lpSecurityDescriptor := nil;
|
|
Sa.bInheritHandle := True;
|
|
if IsWinNT then
|
|
Result := @Sa
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
//=== Privileges =============================================================
|
|
|
|
function IsAdministrator: Boolean;
|
|
var
|
|
psidAdmin: Pointer;
|
|
Token: THandle;
|
|
Count: DWORD;
|
|
TokenInfo: PTokenGroups;
|
|
HaveToken: Boolean;
|
|
I: Integer;
|
|
const
|
|
SE_GROUP_USE_FOR_DENY_ONLY = $00000010;
|
|
begin
|
|
Result := not IsWinNT;
|
|
if Result then // Win9x/ME
|
|
Exit;
|
|
psidAdmin := nil;
|
|
TokenInfo := nil;
|
|
HaveToken := False;
|
|
try
|
|
Token := 0;
|
|
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token);
|
|
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
|
|
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
|
|
if HaveToken then
|
|
begin
|
|
{$IFDEF FPC}
|
|
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
|
|
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
|
|
psidAdmin));
|
|
if GetTokenInformation(Token, TokenGroups, nil, 0, @Count) or
|
|
(GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
|
|
RaiseLastOSError;
|
|
TokenInfo := PTokenGroups(AllocMem(Count));
|
|
Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, @Count));
|
|
{$ELSE FPC}
|
|
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
|
|
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
|
|
psidAdmin));
|
|
if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or
|
|
(GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
|
|
RaiseLastOSError;
|
|
TokenInfo := PTokenGroups(AllocMem(Count));
|
|
Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count));
|
|
{$ENDIF FPC}
|
|
for I := 0 to TokenInfo^.GroupCount - 1 do
|
|
begin
|
|
{$RANGECHECKS OFF} // Groups is an array [0..0] of TSIDAndAttributes, ignore ERangeError
|
|
Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid);
|
|
if Result then
|
|
begin
|
|
//consider denied ACE with Administrator SID
|
|
Result := TokenInfo^.Groups[I].Attributes and SE_GROUP_USE_FOR_DENY_ONLY
|
|
<> SE_GROUP_USE_FOR_DENY_ONLY;
|
|
Break;
|
|
end;
|
|
{$IFDEF RANGECHECKS_ON}
|
|
{$RANGECHECKS ON}
|
|
{$ENDIF RANGECHECKS_ON}
|
|
end;
|
|
end;
|
|
finally
|
|
if TokenInfo <> nil then
|
|
FreeMem(TokenInfo);
|
|
if HaveToken then
|
|
CloseHandle(Token);
|
|
if psidAdmin <> nil then
|
|
FreeSid(psidAdmin);
|
|
end;
|
|
end;
|
|
|
|
function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean;
|
|
const
|
|
PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
|
|
var
|
|
Token: THandle;
|
|
TokenPriv: TTokenPrivileges;
|
|
begin
|
|
Result := not IsWinNT;
|
|
if Result then // if Win9x, then function return True
|
|
Exit;
|
|
Token := 0;
|
|
if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then
|
|
begin
|
|
TokenPriv.PrivilegeCount := 1;
|
|
LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
|
|
TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
|
|
JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil);
|
|
Result := GetLastError = ERROR_SUCCESS;
|
|
CloseHandle(Token);
|
|
end;
|
|
end;
|
|
|
|
function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean;
|
|
const
|
|
PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
|
|
var
|
|
Token: THandle;
|
|
TokenPriv: TTokenPrivileges;
|
|
HaveToken: Boolean;
|
|
begin
|
|
Result := not IsWinNT;
|
|
if Result then // Win9x/ME
|
|
Exit;
|
|
Token := 0;
|
|
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_ADJUST_PRIVILEGES,
|
|
False, Token);
|
|
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
|
|
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token);
|
|
if HaveToken then
|
|
begin
|
|
TokenPriv.PrivilegeCount := 1;
|
|
LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
|
|
TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
|
|
JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil);
|
|
Result := GetLastError = ERROR_SUCCESS;
|
|
CloseHandle(Token);
|
|
end;
|
|
end;
|
|
|
|
function IsPrivilegeEnabled(const Privilege: string): Boolean;
|
|
var
|
|
Token: THandle;
|
|
TokenPriv: TPrivilegeSet;
|
|
Res: LongBool;
|
|
HaveToken: Boolean;
|
|
begin
|
|
Result := not IsWinNT;
|
|
if Result then // Win9x/ME
|
|
Exit;
|
|
Token := 0;
|
|
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, False, Token);
|
|
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
|
|
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
|
|
if HaveToken then
|
|
begin
|
|
TokenPriv.PrivilegeCount := 1;
|
|
TokenPriv.Control := 0;
|
|
LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privilege[0].Luid);
|
|
Res := False;
|
|
Result := PrivilegeCheck(Token, TokenPriv, Res) and Res;
|
|
CloseHandle(Token);
|
|
end;
|
|
end;
|
|
|
|
function GetPrivilegeDisplayName(const PrivilegeName: string): string;
|
|
var
|
|
Count: DWORD;
|
|
LangID: DWORD;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
Count := 0;
|
|
LangID := LANG_USER_DEFAULT;
|
|
|
|
// have the the API function determine the required string length
|
|
Result := '';
|
|
if not LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then
|
|
Count := 256;
|
|
SetLength(Result, Count + 1);
|
|
|
|
if LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then
|
|
StrResetLength(Result)
|
|
else
|
|
Result := '';
|
|
end
|
|
else
|
|
Result := ''; // Win9x/ME
|
|
end;
|
|
|
|
function SetUserObjectFullAccess(hUserObject: THandle): Boolean;
|
|
var
|
|
Sd: PSecurity_Descriptor;
|
|
Si: Security_Information;
|
|
begin
|
|
Result := not IsWinNT;
|
|
if Result then // Win9x/ME
|
|
Exit;
|
|
{ TODO : Check the success of called functions }
|
|
Sd := PSecurity_Descriptor(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH));
|
|
InitializeSecurityDescriptor(Sd, SECURITY_DESCRIPTOR_REVISION);
|
|
SetSecurityDescriptorDacl(Sd, True, nil, False);
|
|
|
|
Si := DACL_SECURITY_INFORMATION;
|
|
Result := SetUserObjectSecurity(hUserObject, Si, Sd);
|
|
|
|
LocalFree(HLOCAL(Sd));
|
|
end;
|
|
|
|
function GetUserObjectName(hUserObject: THandle): string;
|
|
var
|
|
Count: DWORD;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
// have the API function determine the required string length
|
|
Count := 0;
|
|
Result := '';
|
|
GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), 0, Count);
|
|
SetLength(Result, Count + 1);
|
|
|
|
if GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), Count, Count) then
|
|
StrResetLength(Result)
|
|
else
|
|
Result := '';
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
//=== Account Information ====================================================
|
|
|
|
procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString);
|
|
var
|
|
NameSize, DomainSize: DWORD;
|
|
Use: SID_NAME_USE;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
NameSize := 0;
|
|
DomainSize := 0;
|
|
Use := SidTypeUnknown;
|
|
LookupAccountSidA(nil, Sid, nil, NameSize, nil, DomainSize, Use);
|
|
if NameSize > 0 then
|
|
SetLength(Name, NameSize - 1);
|
|
if DomainSize > 0 then
|
|
SetLength(Domain, DomainSize - 1);
|
|
Win32Check(LookupAccountSidA(nil, Sid, PAnsiChar(Name), NameSize, PAnsiChar(Domain), DomainSize, Use));
|
|
end
|
|
else
|
|
begin // if Win9x, then function return ''
|
|
Name := '';
|
|
Domain := '';
|
|
end;
|
|
end;
|
|
|
|
procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString);
|
|
var
|
|
NameSize, DomainSize: DWORD;
|
|
Use: SID_NAME_USE;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
NameSize := 0;
|
|
DomainSize := 0;
|
|
Use := SidTypeUnknown;
|
|
LookupAccountSidW(nil, Sid, nil, NameSize, nil, DomainSize, Use);
|
|
if NameSize > 0 then
|
|
SetLength(Name, NameSize - 1);
|
|
if DomainSize > 0 then
|
|
SetLength(Domain, DomainSize - 1);
|
|
Win32Check(LookupAccountSidW(nil, Sid, PWideChar(Name), NameSize, PWideChar(Domain), DomainSize, Use));
|
|
end
|
|
else
|
|
begin
|
|
Name := '';
|
|
Domain := '';
|
|
end;
|
|
end;
|
|
|
|
procedure QueryTokenInformation(Token: THandle;
|
|
InformationClass: TTokenInformationClass; var Buffer: Pointer);
|
|
var
|
|
Ret: BOOL;
|
|
Length, LastError: DWORD;
|
|
begin
|
|
Buffer := nil;
|
|
if not IsWinNT then // Win9x/ME
|
|
Exit;
|
|
Length := 0;
|
|
{$IFDEF FPC}
|
|
Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length);
|
|
{$ELSE ~FPC}
|
|
Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length);
|
|
{$ENDIF ~FPC}
|
|
if (not Ret) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
|
|
begin
|
|
GetMem(Buffer, Length);
|
|
{$IFDEF FPC}
|
|
Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length);
|
|
{$ELSE ~FPC}
|
|
Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length);
|
|
{$ENDIF ~FPC}
|
|
if not Ret then
|
|
begin
|
|
LastError := GetLastError;
|
|
FreeTokenInformation(Buffer);
|
|
SetLastError(LastError);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FreeTokenInformation(var Buffer: Pointer);
|
|
begin
|
|
if Buffer <> nil then
|
|
FreeMem(Buffer);
|
|
Buffer := nil;
|
|
end;
|
|
|
|
function GetInteractiveUserName: string;
|
|
var
|
|
Handle: THandle;
|
|
Token: THandle;
|
|
User: PTokenUser;
|
|
{$IFDEF SUPPORTS_UNICODE}
|
|
Name, Domain: WideString;
|
|
{$ELSE ~SUPPORTS_UNICODE}
|
|
Name, Domain: AnsiString;
|
|
{$ENDIF ~SUPPORTS_UNICODE}
|
|
begin
|
|
Result := '';
|
|
if not IsWinNT then // if Win9x, then function return ''
|
|
Exit;
|
|
Handle := GetShellProcessHandle;
|
|
try
|
|
Token := 0;
|
|
Win32Check(OpenProcessToken(Handle, TOKEN_QUERY, Token));
|
|
try
|
|
User := nil;
|
|
QueryTokenInformation(Token, TokenUser, Pointer(User));
|
|
try
|
|
LookupAccountBySid(User.User.Sid, Name, Domain);
|
|
Result := Domain + '\' + Name;
|
|
finally
|
|
FreeMem(User);
|
|
end;
|
|
finally
|
|
CloseHandle(Token);
|
|
end;
|
|
finally
|
|
CloseHandle(Handle);
|
|
end;
|
|
end;
|
|
|
|
//=== SID utilities ==========================================================
|
|
|
|
function SIDToString(ASID: PSID): string;
|
|
var
|
|
SidIdAuthority: PSIDIdentifierAuthority;
|
|
SubAuthorities, SidRev, SidSize: DWORD;
|
|
Counter: Integer;
|
|
begin
|
|
SidRev := SID_REVISION;
|
|
|
|
// Validate the binary SID.
|
|
if not IsValidSid(ASid) then
|
|
Raise EJclSecurityError.CreateRes(@RsInvalidSID);
|
|
|
|
// Get the identifier authority value from the SID.
|
|
SidIdAuthority := GetSidIdentifierAuthority(ASid);
|
|
|
|
// Get the number of subauthorities in the SID.
|
|
SubAuthorities := GetSidSubAuthorityCount(ASid)^;
|
|
|
|
//Compute the buffer length.
|
|
// S-SID_REVISION- + IdentifierAuthority- + subauthorities- + NULL
|
|
SidSize := (15 + 12 + (12 * SubAuthorities) + 1) * SizeOf(CHAR);
|
|
|
|
SetLength(Result, SidSize+1);
|
|
|
|
// Add 'S' prefix and revision number to the string.
|
|
Result := Format('S-%u-',[SidRev]);
|
|
|
|
// Add SID identifier authority to the string.
|
|
if (SidIdAuthority^.Value[0] <> 0) or (SidIdAuthority^.Value[1] <> 0) then
|
|
Result := Result + AnsiLowerCase(Format('0x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x',
|
|
[USHORT(SidIdAuthority^.Value[0]),
|
|
USHORT(SidIdAuthority^.Value[1]),
|
|
USHORT(SidIdAuthority^.Value[2]),
|
|
USHORT(SidIdAuthority^.Value[3]),
|
|
USHORT(SidIdAuthority^.Value[4]),
|
|
USHORT(SidIdAuthority^.Value[5])]))
|
|
else
|
|
Result := Result + Format('%u',
|
|
[ULONG(SidIdAuthority^.Value[5])+
|
|
ULONG(SidIdAuthority^.Value[4] shl 8)+
|
|
ULONG(SidIdAuthority^.Value[3] shl 16)+
|
|
ULONG(SidIdAuthority^.Value[2] shl 24)]);
|
|
|
|
// Add SID subauthorities to the string.
|
|
for Counter := 0 to SubAuthorities-1 do
|
|
Result := Result + Format('-%u',[GetSidSubAuthority(ASid, Counter)^]);
|
|
end;
|
|
|
|
procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD);
|
|
var
|
|
{$IFDEF FPC} ASID: PSID; {$ELSE} ASID : ^_SID; {$ENDIF}
|
|
CurrentPos, TempPos: Integer;
|
|
AuthorityValue, RequiredSize: DWORD;
|
|
Authority: string;
|
|
begin
|
|
if (Length (SIDString) <= 3) or (SIDString [1] <> 'S') or (SIDString [2] <> '-') then
|
|
raise EJclSecurityError.CreateRes(@RsInvalidSID);
|
|
|
|
RequiredSize := SizeOf(_SID) - SizeOf(DWORD); // _SID.Revision + _SID.SubAuthorityCount + _SID.IdentifierAuthority
|
|
if cbSID < RequiredSize then
|
|
raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall);
|
|
|
|
ASID := SID; // typecast from opaque structure
|
|
|
|
CurrentPos := StrFind('-', SIDString, 3);
|
|
if CurrentPos <= 0 then
|
|
raise EJclSecurityError.CreateRes(@RsInvalidSID);
|
|
ASID^.Revision := StrToInt(Copy(SIDString, 3, CurrentPos - 3));
|
|
|
|
Inc(CurrentPos);
|
|
TempPos := StrFind('-', SIDString, CurrentPos);
|
|
if TempPos = 0 then
|
|
Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1)
|
|
else
|
|
Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos);
|
|
|
|
if Length(Authority) < 1 then
|
|
raise EJclSecurityError.CreateRes(@RsInvalidSID);
|
|
if (Length(Authority) = 14) and (Authority[1] = '0') and (Authority[2] = 'x') then
|
|
begin
|
|
ASID^.IdentifierAuthority.Value[0] := StrToInt(HexPrefix + Authority[3] + Authority[4]);
|
|
ASID^.IdentifierAuthority.Value[1] := StrToInt(HexPrefix + Authority[5] + Authority[6]);
|
|
ASID^.IdentifierAuthority.Value[2] := StrToInt(HexPrefix + Authority[7] + Authority[8]);
|
|
ASID^.IdentifierAuthority.Value[3] := StrToInt(HexPrefix + Authority[9] + Authority[10]);
|
|
ASID^.IdentifierAuthority.Value[4] := StrToInt(HexPrefix + Authority[11] + Authority[12]);
|
|
ASID^.IdentifierAuthority.Value[5] := StrToInt(HexPrefix + Authority[13] + Authority[14]);
|
|
end
|
|
else
|
|
begin
|
|
ASID^.IdentifierAuthority.Value[0] := 0;
|
|
ASID^.IdentifierAuthority.Value[1] := 0;
|
|
AuthorityValue := StrToInt(Authority);
|
|
ASID^.IdentifierAuthority.Value[2] := (AuthorityValue and $FF000000) shr 24;
|
|
ASID^.IdentifierAuthority.Value[3] := (AuthorityValue and $00FF0000) shr 16;
|
|
ASID^.IdentifierAuthority.Value[4] := (AuthorityValue and $0000FF00) shr 8;
|
|
ASID^.IdentifierAuthority.Value[5] := AuthorityValue and $000000FF;
|
|
end;
|
|
|
|
CurrentPos := TempPos + 1;
|
|
ASID^.SubAuthorityCount := 0;
|
|
|
|
while CurrentPos > 1 do
|
|
begin
|
|
TempPos := StrFind('-', SIDString, CurrentPos);
|
|
|
|
Inc(RequiredSize, SizeOf(DWORD)); // _SID.SubAuthority[x]
|
|
if cbSID < RequiredSize then
|
|
raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall);
|
|
|
|
if TempPos = 0 then
|
|
Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1)
|
|
else
|
|
Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos);
|
|
|
|
{$RANGECHECKS OFF}
|
|
ASID^.SubAuthority[ASID^.SubAuthorityCount] := StrToInt64(Authority);
|
|
{$IFDEF RANGECHECKS_ON}
|
|
{$RANGECHECKS ON}
|
|
{$ENDIF RANGECHECKS_ON}
|
|
Inc(ASID^.SubAuthorityCount);
|
|
|
|
CurrentPos := TempPos + 1;
|
|
end;
|
|
end;
|
|
|
|
//=== Computer Information ===================================================
|
|
|
|
function LsaNTCheck(NTResult: Cardinal) : Cardinal;
|
|
var
|
|
WinError: Cardinal;
|
|
begin
|
|
Result := NTResult;
|
|
if ($C0000000 and Cardinal(NTResult)) = $C0000000 then
|
|
begin
|
|
WinError := LsaNtStatusToWinError(NTResult);
|
|
if WinError <> ERROR_SUCCESS then
|
|
raise EJclSecurityError.CreateResFmt(@RsLsaError, [NTResult, SysErrorMessage(WinError)]);
|
|
end;
|
|
end;
|
|
|
|
function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean;
|
|
var
|
|
ObjectAttributes: TLsaObjectAttributes;
|
|
PolicyHandle: TLsaHandle;
|
|
Info: PPolicyAccountDomainInfo;
|
|
begin
|
|
if IsWinNT then
|
|
begin
|
|
ZeroMemory(@ObjectAttributes,SizeOf(ObjectAttributes));
|
|
|
|
{$IFDEF FPC}
|
|
PolicyHandle := 0;
|
|
{$ENDIF FPC}
|
|
LsaNTCheck(LsaOpenPolicy(nil, // Use local system
|
|
ObjectAttributes, //Object attributes.
|
|
POLICY_VIEW_LOCAL_INFORMATION, // We're just looking
|
|
PolicyHandle)); //Receives the policy handle.
|
|
try
|
|
Info := nil;
|
|
LsaNTCheck(LsaQueryInformationPolicy(PolicyHandle, PolicyAccountDomainInformation,
|
|
Pointer(Info)));
|
|
try
|
|
Result := CopySid(cbSID,SID,Info^.DomainSid);
|
|
finally
|
|
LsaFreeMemory(Info);
|
|
end;
|
|
finally
|
|
LsaClose(PolicyHandle);
|
|
end;
|
|
end
|
|
else
|
|
Result := False; // Win9x
|
|
end;
|
|
|
|
//=== Windows Vista/Server 2008 UAC (User Account Control) ===================
|
|
|
|
function IsUACEnabled: Boolean;
|
|
begin
|
|
Result := (IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2) and
|
|
RegReadBoolDef(HKLM, '\Software\Microsoft\Windows\CurrentVersion\Policies\System', 'EnableLUA', False);
|
|
end;
|
|
|
|
// source: Vista elevator from the Code Project
|
|
function IsElevated: Boolean;
|
|
const
|
|
TokenElevation = TTokenInformationClass(20);
|
|
type
|
|
TOKEN_ELEVATION = record
|
|
TokenIsElevated: DWORD;
|
|
end;
|
|
var
|
|
TokenHandle: THandle;
|
|
ResultLength: Cardinal;
|
|
ATokenElevation: TOKEN_ELEVATION;
|
|
begin
|
|
if (IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2) then
|
|
begin
|
|
TokenHandle := 0;
|
|
if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
|
|
begin
|
|
try
|
|
ResultLength := 0;
|
|
if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
|
|
Result := ATokenElevation.TokenIsElevated <> 0
|
|
else
|
|
Result := False;
|
|
finally
|
|
CloseHandle(TokenHandle);
|
|
end;
|
|
end
|
|
else
|
|
Result := False;
|
|
end
|
|
else
|
|
Result := IsAdministrator;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|