System Delphi

Title: Some useful Windows NT functions
Question: Some useful Windows NT Functions
Answer:
{-----------------------------------------------------------------------------
Unit Name: unitNTFunctions
Author: StewartM
Documentation Date: 22 February, 2002 (11:04)
Version 1.0
-----------------------------------------------------------------------------
Purpose:
To provide a few handy Windows NT API functions.
Description:
Unit written by Stewart Moss (except where indicated)
Some of the functions are incomplete or not tested.
Copyright 2001 by Stewart Moss. All rights reserved.
-----------------------------------------------------------------------------}
unit unitNTFunctions;
// Unit written by Stewart Moss (except where indicated)
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const BSECURITY_NULL_SID_AUTHORITY = 0;
BSECURITY_WORLD_SID_AUTHORITY = 1;
BSECURITY_LOCAL_SID_AUTHORITY = 2;
BSECURITY_CREATOR_SID_AUTHORITY = 3;
BSECURITY_NT_AUTHORITY = 5;
SECURITY_INTERACTIVE_RID = $00000004;
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
ACL_REVISION = 2;
SECURITY_DESCRIPTOR_REVISION = 1;
type
PACE_Header = ^TACE_Header;
TACE_Header = record
AceType: BYTE;
AceFlags: BYTE;
AceSize: WORD;
end;
PAccess_Allowed_ACE = ^TAccess_Allowed_ACE;
TAccess_Allowed_ACE = record
Header: TACE_Header;
Mask: ACCESS_MASK;
SidStart: DWORD;
end;
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
function ISHandleAdministrator(UserToken: THandle): Boolean;
function IsAdmin: Boolean;
function ReturnUserHandle(Username: string): THandle;
function IsWinNT: boolean;
function TryToLoginAsUser(Username, Domain, Password: string): THandle;
implementation
function ISHandleAdministrator(UserToken: THandle): Boolean;
// this function written by Stewart Moss
var
tmpBuffer: array[0..1024] of char;
BufferPtr: Pointer;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWord;
PSIDAdministrators: PSID;
siaNTAuthority: SID_IDENTIFIER_AUTHORITY;
X: DWord;
bSuccess: Boolean;
begin
GetMem(PtgGroups, 1024);
bSuccess := GetTokenInformation(UserToken, TokenGroups, ptgGroups,
1024, dwInfoBufferSize);
result := false;
if not bsuccess then
exit;
if not AllocateAndInitializeSid(siaNtAuthority, 2,
SECURITY_BUILTIN_DOMAIN_RID,
DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0,
psidAdministrators) then
exit;
for x := 0 to ptgGroups.GroupCount do
begin
if EqualSID(psidAdministrators, ptgGroups.Groups[x].SID) then
begin
result := true;
break;
end;
end;
freemem(PtgGroups);
Freemem(PsidAdministrators);
result := true;
end;
function IsAdmin: Boolean;
// This function written by somebody else
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
Result := False;
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
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
ptgGroups, 1024, 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;
end;
function ReturnUserHandle(Username: string): THandle;
// Function written by Stewart Moss
begin
end;
function IsWinNT: boolean;
// Function Written by Stewart Moss
var
osv: TOSVERSIONINFO;
begin
result := false;
osv.dwOSVersionInfoSize := sizeOf(OSVERSIONINFO);
GetVersionEx(osv);
if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
result := true;
end;
function TryToLoginAsUser(Username, Domain, Password: string): THandle;
// Function written by Stewart Moss
// returns 0 if failed else User Handle
var
tmpstr: string;
hToken: THandle;
begin
result := 0;
if (UserName = '') or (Domain = '') then
exit;
if not LogonUser(PChar(Username), Pchar(Domain), PChar(Password),
LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, hToken)
then exit;
result := hToken;
end;
(*function ApplySecurityDescriptorToRegistryKey(Key : Hkey): Boolean;
var lRv : longint;
siaNtAuthority : SID_IDENTIFIER_AUTHORITY;
psidSystem, psidAdministrators: PSID;
tmpACL : ACL;
pNewDACL : PACL;
dwACL : DWord;
ACLRevision : ACL_REVISION_INFORMATION;
begin
siaNtAuthority := SECURITY_NT_AUTHORITY;
result := false;
InitializeSid(psidAdministrators, siaNtAuthority,2);
InitializeSid(psidSystem, siaNtAuthority,1);
//*(GetSidSubAuthority(psidAdministrators,0)) = SECURITY_BUILTIN_DOMAIN_RID;
//*(GetSidSubAuthority(psidAdministrators,1)) = DOMAIN_ALIAS_RID_ADMINS;
//*(GetSidSubAuthority(psidSystem,0)) = SECURITY_LOCAL_SYSTEM_RID;
// getmem(pNewDACL, sizeof(PACL));
// pNewDACL := tmpAcl;
dwAcl := sizeof(PACL);
if not GETAclInformation(pnewAcl,
if (not InitializeAcl(pnewDACL,
dwACL,
ACL_REVISION)) then exit;
if (!AddAccessAllowedAce(pNewDACL,
ACL_REVISION,
KEY_ALL_ACCESS,
psidAdministrators)) return FALSE;
if (!AddAccessAllowedAce(pNewDACL,
ACL_REVISION,
KEY_ALL_ACCESS,
psidSystem)) return FALSE;
if (!InitializeSecurityDescriptor(psdAbsoluteSD,
SECURITY_DESCRIPTOR_REVISION)) return FALSE;
if (!SetSecurityDescriptorDacl(psdAbsoluteSD,
TRUE, // fDaclPresent flag
pNewDACL,
FALSE)) // not a default DACL
return FALSE;
if (!IsValidSecurityDescriptor(psdAbsoluteSD)) return FALSE;

lRv=RegSetKeySecurity(hKey,
(SECURITY_INFORMATION)(DACL_SECURITY_INFORMATION),
psdAbsoluteSD);
if (lRv!=ERROR_SUCCESS) return FALSE;
return TRUE;
}
*)
function do_SetRegACL: boolean;
var sia: TSIDIdentifierAuthority;
pInteractiveSid, pAdministratorsSid: PSID;
sd: Windows.TSecurityDescriptor;
pDacl: PACL;
dwAclSize: DWORD;
aHKey: HKEY;
lRetCode: longint;
bSuccess: boolean;
begin
sia.Value[0] := 0;
sia.Value[1] := 0;
sia.Value[2] := 0;
sia.Value[3] := 0;
sia.Value[4] := 0;
sia.Value[5] := BSECURITY_NT_AUTHORITY;
pInteractiveSid := nil;
pAdministratorsSid := nil;
pDacl := nil;
bSuccess := false; // assume this function fails
//
// open the key for WRITE_DAC access
//
lRetCode := RegOpenKeyEx(
HKEY_CURRENT_USER,
'SOFTWARE\Test',
0,
WRITE_DAC,
aHKey
);
if(lRetCode ERROR_SUCCESS) then begin
ShowMessage('Error in RegOpenKeyEx');
result := false;
end;
//
// prepare a Sid representing any Interactively logged-on user
//
if( not AllocateAndInitializeSid(
sia,
1,
SECURITY_INTERACTIVE_RID,
0, 0, 0, 0, 0, 0, 0,
pInteractiveSid
)) then begin
ShowMessage('Error in: AllocateAndInitializeSid');
//goto cleanup;
end;
//
// prepare a Sid representing the well-known admin group
//
if(not AllocateAndInitializeSid(
sia,
2,
SECURITY_BUILTIN_DOMAIN_RID,
DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0,
pAdministratorsSid
)) then begin
ShowMessage('Error in: AllocateAndInitializeSid');
// goto cleanup;
end;
//
// compute size of new acl
//
dwAclSize := sizeof(TACL) +
2 * ( sizeof(TAccess_Allowed_ACE) - sizeof(DWORD) ) +
GetLengthSid(pInteractiveSid) +
GetLengthSid(pAdministratorsSid) ;
//
// allocate storage for Acl
//
pDacl := PACL(HeapAlloc(GetProcessHeap(), 0, dwAclSize));
//if(pDacl == nil) goto cleanup;
if( not InitializeAcl(pDacl^, dwAclSize, ACL_REVISION)) then begin
ShowMessage('Error in: InitializeAcl');
//goto cleanup;
end;
//
// grant the Interactive Sid KEY_READ access to the perf key
//
if(not AddAccessAllowedAce(
pDacl^,
ACL_REVISION,
KEY_READ,
pInteractiveSid
)) then begin
ShowMessage('Error in: AddAccessAllowedAce');
//goto cleanup;
end;
//
// grant the Administrators Sid KEY_ALL_ACCESS access to the perf key
//
if(not AddAccessAllowedAce(
pDacl^,
ACL_REVISION,
KEY_ALL_ACCESS,
pAdministratorsSid
)) then begin
ShowMessage('Error in: AddAccessAllowedAce');
//goto cleanup;
end;
if(not InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION))
then begin
ShowMessage('Error in: InitializeSecurityDescriptor');
//goto cleanup;
end;
if(not SetSecurityDescriptorDacl(@sd, TRUE, pDacl, FALSE)) then begin
ShowMessage('Error in: SetSecurityDescriptorDacl');
//goto cleanup;
end;
//
// apply the security descriptor to the registry key
//
lRetCode := RegSetKeySecurity(
aHKey,
SECURITY_INFORMATION(DACL_SECURITY_INFORMATION),
@sd
);
if(lRetCode ERROR_SUCCESS) then begin
ShowMessage('Error in: RegSetKeySecurity');
//goto cleanup;
end;
bSuccess := TRUE; // indicate success
end;
end.