MiTec/Common/MiTeC_NTSecAPI.pas
2024-07-06 22:30:25 +02:00

476 lines
15 KiB
ObjectPascal

{*******************************************************}
{ MiTeC Common Routines }
{ NT Security API }
{ }
{ Copyright (c) 1997-2021 Michal Mutl }
{ }
{*******************************************************}
{$INCLUDE Compilers.inc}
unit MiTeC_NTSecAPI;
interface
uses {$IFDEF RAD9PLUS}
WinAPI.Windows, System.SysUtils, System.Classes, WinAPI.Messages, VCL.Controls,
{$ELSE}
Windows, Messages, SysUtils, Classes, Controls,
{$ENDIF}
MiTeC_LSAAPI;
type
ENTException = class(Exception);
const
SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
SE_TCB_NAME = 'SeTcbPrivilege';
SE_SECURITY_NAME = 'SeSecurityPrivilege';
SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
SE_BACKUP_NAME = 'SeBackupPrivilege';
SE_RESTORE_NAME = 'SeRestorePrivilege';
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
SE_DEBUG_NAME = 'SeDebugPrivilege';
SE_AUDIT_NAME = 'SeAuditPrivilege';
SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';
SE_UNDOCK_NAME = 'SeUndockPrivilege';
SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege';
SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege';
SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege';
SE_INTERACTIVE_LOGON_NAME = 'SeInteractiveLogonRight';
SE_NETWORK_LOGON_NAME = 'SeNetworkLogonRight';
SE_BATCH_LOGON_NAME = 'SeBatchLogonRight';
SE_SERVICE_LOGON_NAME = 'SeServiceLogonRight';
SE_DENY_INTERACTIVE_LOGON_NAME = 'SeDenyInteractiveLogonRight';
SE_DENY_NETWORK_LOGON_NAME = 'SeDenyNetworkLogonRight';
SE_DENY_BATCH_LOGON_NAME = 'SeDenyBatchLogonRight';
SE_DENY_SERVICE_LOGON_NAME = 'SeDenyServiceLogonRight';
SE_REMOTE_INTERACTIVE_LOGON_NAME = 'SeRemoteInteractiveLogonRight';
SE_DENY_REMOTE_INTERACTIVE_LOGON_NAME = 'SeDenyRemoteInteractiveLogonRight';
PrivilegeNames : array [0..27] of string = (
SE_INTERACTIVE_LOGON_NAME,
SE_NETWORK_LOGON_NAME,
SE_BATCH_LOGON_NAME,
SE_SERVICE_LOGON_NAME,
SE_CREATE_TOKEN_NAME,
SE_ASSIGNPRIMARYTOKEN_NAME,
SE_LOCK_MEMORY_NAME,
SE_INCREASE_QUOTA_NAME,
SE_UNSOLICITED_INPUT_NAME,
SE_MACHINE_ACCOUNT_NAME,
SE_TCB_NAME,
SE_SECURITY_NAME,
SE_TAKE_OWNERSHIP_NAME,
SE_LOAD_DRIVER_NAME,
SE_SYSTEM_PROFILE_NAME,
SE_SYSTEMTIME_NAME,
SE_PROF_SINGLE_PROCESS_NAME,
SE_INC_BASE_PRIORITY_NAME,
SE_CREATE_PAGEFILE_NAME,
SE_CREATE_PERMANENT_NAME,
SE_BACKUP_NAME,
SE_RESTORE_NAME,
SE_SHUTDOWN_NAME,
SE_DEBUG_NAME,
SE_AUDIT_NAME,
SE_SYSTEM_ENVIRONMENT_NAME,
SE_CHANGE_NOTIFY_NAME,
SE_REMOTE_SHUTDOWN_NAME);
_DELETE = $00010000;
READ_CONTROL = $00020000;
FILE_READ_DATA = $0001; // file & pipe
FILE_LIST_DIRECTORY = $0001; // directory
FILE_WRITE_DATA = $0002; // file & pipe
FILE_ADD_FILE = $0002; // directory
FILE_APPEND_DATA = $0004; // file
FILE_ADD_SUBDIRECTORY = $0004; // directory
FILE_CREATE_PIPE_INSTANCE = $0004; // named pipe
FILE_READ_EA = $0008; // file & directory
FILE_WRITE_EA = $0010; // file & directory
FILE_EXECUTE = $0020; // file
FILE_TRAVERSE = $0020; // directory
FILE_DELETE_CHILD = $0040; // directory
FILE_READ_ATTRIBUTES = $0080; // all
FILE_WRITE_ATTRIBUTES = $0100; // all
FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF;
FILE_GENERIC_READ = STANDARD_RIGHTS_READ or FILE_READ_DATA or FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE;
FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE;
FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or FILE_EXECUTE or SYNCHRONIZE;
PRIV_READ = FILE_READ_DATA or FILE_READ_EA or FILE_READ_ATTRIBUTES or READ_CONTROL or SYNCHRONIZE;
PRIV_READ_EXECUTE = PRIV_READ or FILE_EXECUTE;
PRIV_READ_WRITE = PRIV_READ or FILE_WRITE_DATA or FILE_APPEND_DATA or FILE_WRITE_EA or FILE_WRITE_ATTRIBUTES;
PRIV_READ_WRITE_EXECUTE = PRIV_READ_WRITE or FILE_EXECUTE;
PRIV_CHANGE = PRIV_READ_WRITE_EXECUTE or _DELETE;
PRIV_FULL_CONTROL = PRIV_CHANGE or FILE_DELETE_CHILD or WRITE_DAC or WRITE_OWNER;
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
type
TGrantPermissionSid = record { must keep in synch with Helper.c }
Authority: TSIDIdentifierAuthority;
SubAuthCount: Byte;
SubAuth: array[0..1] of Cardinal;
end;
TGrantPermissionEntry = record { must keep in synch with Helper.c }
Sid: TGrantPermissionSid;
AccessMask: Cardinal;
end;
function IsAdminAccount(const ADomain,AName,APassword: string): Boolean;
procedure GetObjectAccessRights (const AComputername,objectName : string; list : TStrings);
function GetPrivilegeDisplayName (const Acomputername, privilege : string) : string;
procedure GrantPrivilege (const acomputername,accountServer, user, privilege : string; bRemove : boolean);
function GrantPermissionOnFile(Filename: string; const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;
function GetMachine :string;
var
MachineName: string;
implementation
uses {$IFDEF RAD9PLUS}
System.Win.Registry,
{$ELSE}
Registry,
{$ENDIF}
MiTeC_AclApi;
const
KEY_WOW64_64KEY = $0100;
function WideToAnsi(const ws: WideString; codePage: Word = CP_ACP): AnsiString;
var
l: integer;
f: Cardinal;
begin
f:=WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR;
if codepage=CP_UTF8 then
f:=0;
if ws = '' then
Result := ''
else begin
l := WideCharToMultiByte(codePage,f,@ws[1],-1,nil,0,nil,nil);
SetLength(Result,l-1);
if l>1 then
WideCharToMultiByte(codePage,f,@ws[1],-1,@Result[1],l-1,nil,nil);
end;
end;
function GetMachine :string;
var
n :Cardinal;
buf :PChar;
const
rkMachine = {HKEY_LOCAL_MACHINE}'\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName';
rvMachine = 'ComputerName';
begin
n:=255;
buf:=stralloc(n);
GetComputerName(buf,n);
result:=buf;
strdispose(buf);
with TRegistry.Create(KEY_READ or KEY_WOW64_64KEY) do begin
rootkey:=HKEY_LOCAL_MACHINE;
if OpenKey(rkMachine,False) then begin
if ValueExists(rvMachine) then
result:=ReadString(rvMachine);
closekey;
end;
free;
end;
end;
function IsAdminAccount;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: Cardinal;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
s: string;
begin
if SameText(ADomain,Machinename) then
s:=AName
else
s:=Format('%s@%s',[AName,ADomain]);
GrantPrivilege('','',s,SE_SERVICE_LOGON_NAME,False);
try
Result:=False;
bSuccess:=LogonUser(PChar(AName),PChar(ADomain),PChar(APassword),LOGON32_LOGON_SERVICE,LOGON32_PROVIDER_DEFAULT,hAccessToken);
if bSuccess then begin
GetTokenInformation(hAccessToken,TokenGroups,nil,0,dwInfoBufferSize);
GetMem(ptgGroups, dwInfoBufferSize);
bSuccess:=GetTokenInformation(hAccessToken,TokenGroups,ptgGroups,dwInfoBufferSize,dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for x:=0 to ptgGroups.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then begin
Result:=True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
finally
GrantPrivilege('','',s,SE_SERVICE_LOGON_NAME,True);
end;
end;
function GetPrivilegeDisplayName;
var
languageID : cardinal;
buffer : array [0..256] of char;
bufSize : cardinal;
begin
bufSize := sizeof (buffer);
if LookupPrivilegeDisplayName(PChar(aComputername), PChar (privilege), buffer, bufSize, languageID) then
result := buffer
else
result := privilege;
// raise ENTException.CreateLastError;
end;
procedure GetObjectAccessRights;
var
sid : PSID;
sidSize : Cardinal;
sidNameUse : SID_NAME_USE;
domainName : array [0..256] of char;
domainNameSize : Cardinal;
lsaComputerName : TLsaUnicodeStr;
lsaRights, p : PLsaUnicodeString;
objectAttributes : TLsaObjectAttributes;
policyHandle : LSA_HANDLE;
status : NTSTATUS;
rightsCount, i, err : Cardinal;
begin
list.Clear;
sidSize := 65536;
GetMem (sid, sidSize);
try
domainNameSize:=256;
if LookupAccountName (PChar (aComputername), PChar (objectName), sid, sidSize, domainName, domainNameSize, sidNameUse) then
begin
ReallocMem (sid, sidSize);
lsaComputerName := TLsaUnicodeStr.CreateFromStr (aComputername);
try
FillChar (objectAttributes, sizeof (objectAttributes), 0);
status := LsaOpenPolicy (lsaComputername.Value, ObjectAttributes, POLICY_LOOKUP_NAMES, PolicyHandle);
if status = STATUS_SUCCESS then
try
status := LsaEnumerateAccountRights (PolicyHandle, sid, lsaRights, rightsCount);
if status = STATUS_SUCCESS then
try
p := lsaRights;
for i := 0 to rightsCount - 1 do
begin
list.Add (LsaUnicodeStringToStr (p^));
Inc (p)
end
finally
LsaFreeMemory (lsaRights)
end
else
begin
err := LsaNTStatusToWinError (status);
if err <> 2 then
raise ENTException.Create(IntToStr(err))
end
finally
LsaClose (PolicyHandle)
end
else raise ENTException.Create(IntToStr(LsaNTStatusToWinError (status)));
finally
lsaComputerName.Free
end
end
else raise ENTException.Create(IntToStr(GetLastError));
finally
FreeMem (sid)
end
end;
procedure GrantPrivilege;
var
sid : PSID;
sidSize: Cardinal;
sidNameUse: SID_NAME_USE;
domainNameSize : Cardinal;
domainName : array [0..256] of char;
attributes : TLsaObjectAttributes;
policyHandle : LSA_HANDLE;
lsaComputerName, rightsLsaUnicodeString : TLSAUnicodeStr;
status : NTStatus;
begin
sidSize := 65536;
GetMem (sid, sidSize);
domainNameSize := 256;
try
if LookupAccountName (PChar (accountServer), PChar (user), sid, sidSize, domainName, domainNameSize, sidNameUse) then begin
lsaComputerName := TLsaUnicodeStr.CreateFromStr (aComputername);
try
FillChar (attributes, SizeOf (attributes), 0);
status := LsaOpenPolicy (lsaComputerName.value, attributes, POLICY_CREATE_ACCOUNT or POLICY_LOOKUP_NAMES, policyHandle);
if status = STATUS_SUCCESS then
try
rightsLsaUnicodeString := TLsaUnicodeStr.CreateFromStr (privilege);
try
if bRemove then
status := LsaRemoveAccountRights (PolicyHandle, sid, False, @rightsLsaUnicodeString.value, 1)
else
status := LsaAddAccountRights (PolicyHandle, sid, @rightsLsaUnicodeString.value, 1);
if status <> STATUS_SUCCESS then
raise ENTException.Create (IntToStr(LsaNtStatusToWinError (status)));
finally
rightsLsaUnicodeString.Free
end
finally
LsaClose (PolicyHandle)
end
finally
lsaComputerName.Free
end
end
finally
FreeMem (sid)
end
end;
function InternalGrantPermission(const ObjectType: TSeObjectType; const ObjectName: String;
const Entries: TGrantPermissionEntry; const EntryCount: Integer;
const Inheritance: DWORD): DWORD;
var
SD: PSECURITY_DESCRIPTOR;
Dacl, NewDacl: PACL;
ExplicitAccess: PExplicitAccessW;
E: ^TGrantPermissionEntry;
I: Integer;
Sid: PSID;
begin
if (Lo(GetVersion) < 5) then begin
Result := ERROR_INVALID_FUNCTION;
Exit;
end;
ExplicitAccess := nil;
Result := GetNamedSecurityInfoA(PAnsiChar({$IFDEF UNICODE}WideToAnsi{$ENDIF}(ObjectName)), ObjectType, DACL_SECURITY_INFORMATION,
nil, nil, @Dacl, nil, SD);
if Result <> ERROR_SUCCESS then
Exit;
try
ExplicitAccess := AllocMem(EntryCount * SizeOf(TExplicitAccess));
E := @Entries;
for I := 0 to EntryCount-1 do begin
if not AllocateAndInitializeSid(E.Sid.Authority, E.Sid.SubAuthCount,
E.Sid.SubAuth[0], E.Sid.SubAuth[1], 0, 0, 0, 0, 0, 0, Sid) then begin
Result := GetLastError;
if Result = ERROR_SUCCESS then { just in case... }
Result := ERROR_INVALID_PARAMETER;
Exit;
end;
ExplicitAccess.grfAccessPermissions := E.AccessMask;
ExplicitAccess.grfAccessMode := GRANT_ACCESS;
ExplicitAccess.grfInheritance := Inheritance;
ExplicitAccess.Trustee.TrusteeForm := TRUSTEE_IS_SID;
ExplicitAccess.Trustee.TrusteeType := TRUSTEE_IS_UNKNOWN;
PSID(ExplicitAccess.Trustee.ptstrName) := Sid;
Inc(E);
inc(ExplicitAccess);
end;
Result := SetEntriesInAclW(EntryCount, ExplicitAccess, Dacl, NewDacl);
if Result <> ERROR_SUCCESS then
Exit;
try
Result := SetNamedSecurityInfoA(PAnsiChar({$IFDEF UNICODE}WideToAnsi{$ENDIF}(ObjectName)), ObjectType,
DACL_SECURITY_INFORMATION, nil, nil, NewDacl, nil);
finally
LocalFree(HLOCAL(NewDacl));
end;
finally
if Assigned(ExplicitAccess) then begin
for I := EntryCount-1 downto 0 do begin
Sid := PSID(ExplicitAccess.Trustee.ptstrName);
if Assigned(Sid) then
FreeSid(Sid);
inc(ExplicitAccess);
end;
FreeMem(ExplicitAccess);
end;
LocalFree(HLOCAL(SD));
end;
end;
function PathExpand(const Filename: String): String;
var
Res: Integer;
FilePart: PChar;
Buf: array[0..4095] of Char;
begin
Cardinal(Res) := GetFullPathName(PChar(Filename), SizeOf(Buf), Buf, FilePart);
if (Res > 0) and (Res < SizeOf(Buf)) then
SetString(Result, Buf, Res)
else
Result := Filename;
end;
function GrantPermissionOnFile(Filename: string; const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;
var
Attr, Inheritance, ErrorCode: DWORD;
begin
Filename := PathExpand(Filename);
Attr := GetFileAttributes(PChar(FileName));
if Attr = $FFFFFFFF then begin
Result := False;
Exit;
end;
if Attr and FILE_ATTRIBUTE_DIRECTORY <> 0 then
Inheritance := SUB_OBJECTS_ONLY_INHERIT or SUB_CONTAINERS_ONLY_INHERIT
else
Inheritance := 0;
ErrorCode := InternalGrantPermission(SE_FILE_OBJECT, Filename, Entries,
EntryCount, Inheritance);
SetLastError(ErrorCode);
Result := (ErrorCode = ERROR_SUCCESS);
end;
initialization
MachineName:=GetMachine;
end.