lina-components/Source/uSysTools.pas

unit uSysTools;

//////////////////////////////////////
///  Lina System Tools Unit        ///
///  ****************************  ///
///  (c) 2014 Dennis Göhlert a.o.  ///
//////////////////////////////////////

interface

  { Da Delphi vor Version 2009 noch keine Generics kannte, musste die
    TIntegerList-,TBooleanList-,TFloatList- und TPointList-Deklaration auf
    Compiler-Versionen 20.0 oder höher beschränkt werden.
    Meines Wissens nach gibt es keine einfache Möglichkeit, Typisierte Listen
    auch in ältere Versionen zu integrieren. }

uses
  { Standard-Units }
  Classes, SysUtils, Math, Windows,
  {$IFNDEF NO_GENERIC}
    Types, Generics.Collections,
  {$ENDIF}
  { Andere Package-Units }
  uFileTools, uBase;

type
  { Fehlermeldungen }
  EWinUserInformation = class(Exception);
  EInvalidValueType = class(Exception);

type
  {$IFNDEF NO_GENERIC}
    TIntegerList = TList<Integer>;
    TBooleanList = TList<Boolean>;
    TFloatList = TList<Extended>;
    TPointList = TList<TPoint>;
  {$ENDIF}

  { Typenumwandelungen }
  function BoolToInt(B: Boolean): Integer;
  function IntToBool(Value: Integer): Boolean;
  { Typen-Äquivalenz-Prüfungen }
  function StrIsInt(const S: String): Boolean;
  function StrIsFloat(const S: String): Boolean;
  function StrIsBool(const S: String): Boolean;
  function FloatIsInt(Value: Extended): Boolean;
  { WinUser }
  function WinUserName: String;
  function WinUserDirectory: String;
  function WinUserAdmin: Boolean;
  function WinUserExists(UsrNme: String): Boolean;
  { Sonstige }
  function SecToTime(const Sec: Cardinal): TTime;
  function SystemLanguage: String;
  function Empty(var Val): Boolean;

implementation

function BoolToInt(B: Boolean): Integer;
begin
  if B then
  begin
    Result := not 0;
  end else
  begin
    Result := 0;
  end;
end;

function IntToBool(Value: Integer): Boolean;
begin
  Result := (Value <> 0);
end;

function StrIsInt(const S: String): Boolean;
var
  TryMethodBuffer: Integer;
begin
  Result := TryStrToInt(S,TryMethodBuffer);
end;

function StrIsFloat(const S: String): Boolean;
var
  TryMethodBuffer: Extended;
begin
  Result := TryStrToFloat(S,TryMethodBuffer);
end;

function StrIsBool(const S: String): Boolean;
var
  TryMethodBuffer: Boolean;
begin
  Result := TryStrToBool(S,TryMethodBuffer);
end;

function FloatIsInt(Value: Extended): Boolean;
begin
  Result := (Ceil(Value) = Floor(Value));
end;

function SecToTime(const Sec: Cardinal): TTime;
var
   TH, TM, TS: String;
   SH, SM, SS: Integer;
begin
  if Sec <= 0 then
  begin
    Result := StrToTime('00:00:00');
    Exit;
  end;
  SH := Sec div 3600;
  SM := Sec div 60 - SH * 60;
  SS := Sec - (SH * 3600 + SM * 60) ;
  TH := IntToStr(SH);
  TM := IntToStr(SM);
  TS := IntToStr(SS);
  Result := StrToTime(TH + ':' + TM + ':' + TS);
end;

function SystemLanguage: String;
begin
  Result := Languages.NameFromLocaleID[Languages.UserDefaultLocale];
end;

function Empty(var Val): Boolean;
begin
  if Val is Pointer then
  begin
    Result := (Val = nil);
  end else
  begin
    if Val is TObject then
    begin
      Val = (Val as TObject).

    end else
    begin
      raise EInvalidValueType.Create('Unsupported value type: ' + ToString(Val));
    end;
  end;
end;

function WinUserName: String;
var
  Buffer: array [0..255] of Char;
  Size: DWord;
begin
  Size := SizeOf(Buffer);
  if not GetUserName(Buffer, Size) then
  begin
    raise EWinUserInformation.Create('Could not collect information on user name');
  end;
  SetString(Result,Buffer,Size - 1);
end;

function WinUserDirectory: String;
begin
  Result := GetEnvironmentVariable('USERPROFILE');
end;

function WinUserAdmin: Boolean;
const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0,0,0,0,0,5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;
var
  hAccessToken: THandle;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdministrators: PSID;
  X: Integer;
  bSuccess: BOOL;
begin
  Result := False;
  bSuccess := False;
  ptgGroups := nil;
  psidAdministrators := nil;
  try
    bSuccess := OpenThreadToken(GetCurrentThread,TOKEN_QUERY,True,hAccessToken);
    if not bSuccess then
    begin
      if GetLastError = ERROR_NO_TOKEN then
      begin
        bSuccess := OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,hAccessToken);
      end;
    end;
    if bSuccess then
    begin
      GetMem(ptgGroups,1024);
      bSuccess := GetTokenInformation(hAccessToken,TokenGroups,ptgGroups,1024,dwInfoBufferSize);
      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
        begin
          if EqualSid(psidAdministrators,ptgGroups.Groups[X].Sid) then
          begin
            Result := True;
            Break;
          end;
        end;
        {$R+}
      end;
    end;
  finally
    if bSuccess then
    begin
      CloseHandle(hAccessToken);
    end;
    if Assigned(ptgGroups) then
    begin
      FreeMem(ptgGroups);
    end;
    if Assigned(psidAdministrators) then
    begin
      FreeSid(psidAdministrators);
    end;
  end;
end;

function WinUserExists(UsrNme: String): Boolean;
begin
  Result := False;
  //...   MUSS NOCH GESCHRIEBEN WERDEN!!!
end;

end.