Mega Code Archive
Detect an windows administrator login
If you develop certain applications that require an Administrator login for installation you will face yourself with this question - 'How can I know whether the current user is an Administrator' ?
Evaluating the user name is not sufficient, since any user can have Admin privileges.
The solution:
First off, one can try to detect whether the machine is running Windows 95/ 98/ ME. These operating systems have no concept of an 'Administrator'. In all other cases (NT, Win2000) you have to explicitely check the account privileges.
The code below does both, use it like this:
if isAdmin then
begin
ShowMessage('Logged in as Administrator');
end;
{$APPTYPE CONSOLE}
program isAdmin;
uses
SysUtils, Windows, Forms;
{$R *.RES}
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
// return TRUE for Admins (or Win95/98/ME)
function Is_Admin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
Result := True;
exit;
end;
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;
begin
if Is_Admin then
Writeln(1)
else
Writeln(0);
end.