jclsecurity.pas

East make Tray Icon in delphi

    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);
    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
    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
    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: string);
var
  NameSize, DomainSize: DWORD;
  Use: SID_NAME_USE;
begin
  if IsWinNT then
  begin
    NameSize := 0;
    DomainSize := 0;
    { TODO : Check the success }
    LookupAccountSid(nil, Sid, nil, NameSize, nil, DomainSize, Use);
    SetLength(Name, NameSize);
    SetLength(Domain, DomainSize);
    Win32Check(LookupAccountSid(nil, Sid, PChar(Name), NameSize, PChar(Domain), DomainSize, Use));
    SetLength(Domain, StrLen(PChar(Domain)));
    SetLength(Name, StrLen(PChar(Name)));
  end
  else
  begin             // if Win9x, then function return ''
    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}
  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}
    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;

{$IFNDEF FPC} // JclSysInfo.GetShellProcessHandle not available
function GetInteractiveUserName: string;
var
  Handle: THandle;
  Token: THandle;
  User: PTokenUser;
  Name, Domain: string;
begin
  Result := '';
  if not IsWinNT then  // if Win9x, then function return ''
    Exit;
  Handle := GetShellProcessHandle;
  try
    Win32Check(OpenProcessToken(Handle, TOKEN_QUERY, Token));
    try
      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;
{$ENDIF ~FPC}

// History:

// $Log: JclSecurity.pas,v $
// Revision 1.17  2005/02/25 07:20:16  marquardt
// add section lines
//
// Revision 1.16  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.15  2004/10/25 08:51:23  marquardt
// PH cleaning
//
// Revision 1.14  2004/10/17 21:00:16  mthoma
// cleaning
//
// Revision 1.13  2004/07/29 07:58:22  marquardt
// inc files updated
//
// Revision 1.12  2004/07/28 18:00:54  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.11  2004/06/14 11:05:53  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.10  2004/06/02 03:23:47  rrossmair
// cosmetic changes in several units (code formatting, help TODOs processed etc.)
//
// Revision 1.9  2004/05/13 07:46:06  rrossmair
// changes for FPC 1.9.3+ compatibility
//
// Revision 1.8  2004/05/05 07:30:54  rrossmair
// Changes for FPC compatibility; header updated according to new policy: initial developers & contributors listed
//
// Revision 1.7  2004/04/06 04:55:18  
// adapt compiler conditions, add log entry
//

end.