delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback



Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi








Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (3)


Some useful Windows NT functionsFormat this article printer-friendly!Bookmark function is only available for registered users!
Product:
Delphi all versions
Category:
System
Skill Level:
Scoring:
Last Update:
02/22/2002
Search Keys:
delphi delphi3000 article borland vcl code-snippet windows-nt api isadmin administrator logon-as-user
Times Scored:
5
Visits:
4913
Uploader: Stewart Moss
Company: New Heights Software Developme
Reference: N/A
 
Question/Problem/Abstract:
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.








Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment
hehehe
    Stewart Moss (Feb 27 2002 2:44PM)

Ok, ok...

I have actually been going through my code library and putting aside stuff, which I have written, to upload to delphi3000.com

I will be producing an article for WinNT, Internet (sockets) and Assembler.

GIVE ME SOME TIME (laugh)

ta ;)
Respond

Absolutely no text?
    Laust Rud Jensen (Feb 27 2002 1:22PM)

Why oh why don't you write an article?
Respond

RE: Absolutely no text?
Adam Bond (Feb 27 2002 3:58PM)

I dont see the problem with code only, if your a half decent programmer then you will be able to work it out.

If i fancy sitting down with a cup of coffee and some chocy bickies then i would want an article that i can spend some time reading, if im in work and rushed i want some code that i can use or give me an idea of what to do.

So in this way both articles and chunks of code are usfull and both earn the right to be on delphi3000 side by side.

Just a thought.


P.S.

Nice chunk of code :)




Respond














 
Sign up to consume product discounts for Bronze memberships !

read more


   


  Community Ad of
S. Kucherov
 
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)