Subversion Repositories delphiutils

////////////////////////////////////////////////////////////////////////////////////

// RECYCLE-BIN-FUNCTIONS BY DANIEL MARSCHALL                                      //

// E-MAIL: info@daniel-marschall.de                                               //

// WEB:    www.daniel-marschall.de                                                //

////////////////////////////////////////////////////////////////////////////////////

// Revision: 16 JUN 2010                                                          //

// This unit is freeware, but please link to my website if you are using it!      //

////////////////////////////////////////////////////////////////////////////////////

// Successful tested with:                                                        //

// Windows 95b, 95b + IE4, 98-SE, XP-SP2, 2000-SP4, 2003-SRV-EE-SP1, VISTA        //

////////////////////////////////////////////////////////////////////////////////////

//                                                                                //

//  Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //

//  RecyclerGetDateTime() functions, because the unit "DateUtils" is missing.     //

//  Warning! This is a platform unit.                                             //

//                                                                                //

//  To do! Can you help?                                                          //

//    - WideString-Support (input/output)                                         //

//    - GetLoginNameW: Really 255 maximum?                                        //

//    - Always do EOF before reading anything?                                    //

//    - Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext?   //

//    - RecyclerGetInfofiles() check additionally for removable device?           //

//      RecyclerIsValid() is false.                                               //

//    - Function to get current state of recycle-bin (full, empty)                //

//    - Make functions to get the correct icons of full, empty, current           //

//                                                                                //

//  Unknown! Do you know the answer?                                              //

//    - How does Windows 9x/NT manage the daylight saving time (if it does)?      //

//    - How does Windows Vista react to a RECYCLER\ folder on a NTFS device?      //

//    - How does Windows Vista react to a RECYCLED\ folder on a FAT device?       //

//                                                                                //

//  Not analyzed yet! Please send me your trash folder contents for analyzing!    //

//    - Windows NT                                                                //

//    - Windows CE?                                                               //

//    - Windows 7                                                                 //

//                                                                                //

//  Thanks to all these who have helped me solving coding problems.               //

//  Thanks to SEBA for sending in the Windows Vista trash structure files.        //

//  Thanks to OMATA for testing the unit with Delphi 4.                           //

//  Thanks to DEITYSOU for making a bugfix of DriveExists()                       //

//                                                                                //

////////////////////////////////////////////////////////////////////////////////////

(*

== TODO LISTE ==

Wichtig! Windows XP: InfoTip, IntroText und LocalizedString sind Resourcenangaben und müssen ausgelesen werden!

Testen: Wie reagiert Windows, wenn Bitbucket\C existiert, aber kein Wert 'Percent' hat? Mit der Standardeinstellung?

Bug: Windows 2000 bei bestehenden Windows 95 Partition: Recycler Filename ist dann Recycled und nicht Recycler!

bug? w95 recycled file hat immer selben löschzeitpunkt und größe? war die nicht verschieden?

Feature: win7 support

beachtet? bei leerem papierkorb auf fat ist weder info noch info2 vorhanden?

testen: auch möglich, einen vista papierkorb offline öffnen?

Problem: bei win95(ohne ie4) und win2000 gleichzeitiger installation: es existiert info UND info2!!!

Neue Funktionen: GetCurrentRecyclerIcon, GetFullIcon, GetEmptyIcon

Bei Vista gibt es manchmal einen c0000013 Fehler. (Auslesen des ganzen Papierkorbs)

Windows 7 miteinbeziehen!

Implement SETTER functions to every kind of configuration thing. (percentage etc)

Registry CURRENT_USER: Funktionen auch für fremde Benutzer zur Verfügung stellen?

- Future -

Demoapplikation: Dateien statt als Text als Explorer-Like?

Einzelne Elemente oder alle wiederherstellen oder löschen

Konfiguration für Laufwerke ändern etc

IconString -> TIcon Convertion functions

platzreservierung in mb-angabe berechnen

I don't know if there exists any API function which checks the state at any internal way.

*)

// TODO: Also include BC++ Versions

{$IFNDEF BCB}

{$DEFINE DEL1UP}

{$IFNDEF VER80}

{$DEFINE DEL2UP}

{$IFNDEF VER90}

{$DEFINE DEL3UP}

{$IFNDEF VER100}

{$DEFINE DEL4UP}

{$IFNDEF VER120}

{$DEFINE DEL5UP}

{$IFNDEF VER130}

{$DEFINE DEL6UP}

{$IFNDEF VER140}

{$DEFINE DEL7UP}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$IFDEF DEL7UP}

{$WARN UNSAFE_TYPE OFF}

{$WARN UNSAFE_CODE OFF}

{$WARN UNSAFE_CAST OFF}

{$ENDIF}

{$IFDEF DEL6UP}

unit RecyclerFunctions platform;

{$ELSE}

unit RecyclerFunctions;

{$ENDIF}

// Configuration

// If enabled, all functions with parameter "InfofileOrRecycleFolder" will

// also accept files which are not the indexfile (then, a INFO2 or INFO file

// will be searched in this directory).

{.$DEFINE allow_all_filenames}

interface

uses

  Windows, SysUtils, Classes, {$IFDEF DEL6UP}DateUtils,{$ENDIF}

  ShellApi{$IFNDEF DEL6UP}, FileCtrl{$ENDIF}, Registry,

  BitOps, Messages;

type

  EUnknownState = class(Exception);

  EEventCategoryNotDefined = class(Exception);

  EAPICallError = class(Exception);

  PSHQueryRBInfo = ^TSHQueryRBInfo;

  TSHQueryRBInfo = packed record

    cbSize      : dword;

    i64Size     : int64;

    i64NumItems : int64;

  end;

const

  RECYCLER_CLSID = '{645FF040-5081-101B-9F08-00AA002F954E}';

{$IFDEF DEL6UP}

function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;

function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;

function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;

function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;

{$ENDIF}

function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;

function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;

function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;

function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;

function RecyclerGetSource(drive: char; fileid: string): string; overload;

function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;

function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;

function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;

procedure RecyclerListIndexes(drive: char; result: TStringList); overload;

procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;

procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;

function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;

function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;

function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;

function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;

function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;

function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;

function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;

function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;

function RecyclerIsValid(drive: char): boolean; overload;

function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;

function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;

function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;

function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;

function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;

function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;

function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;

function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;

function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;

function RecyclerGetPath(drive: char; UserSID: string): string; overload;

function RecyclerGetPath(drive: char): string; overload;

procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;

procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;

procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;

procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;

procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;

function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;

function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;

function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;

function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;

function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;

function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;

procedure RecyclerGetAllRecyclerDrives(result: TStringList);

function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;

function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;

function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;

function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;

function RecyclerConfirmationDialogEnabled: boolean;

procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);

function RecyclerGetCurrentIconString: string;

function RecyclerGetDefaultIconString: string;

function RecyclerGetEmptyIconString: string;

function RecyclerGetFullIconString: string;

function RecyclerGetName: string;

function RecyclerGetInfoTip: string;

function RecyclerGetIntroText: string;

function RecyclerEmptyEventGetName: string;

function RecyclerEmptyEventGetCurrentSound: string;

function RecyclerEmptyEventGetDefaultSound: string;

procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);

function RecyclerEmptyEventGetSound(ACategory: string): string;

function RecyclerGlobalGetPercentUsage: integer;

function RecyclerSpecificGetPercentUsage(Drive: Char): integer;

function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;

function RecyclerGlobalIsNukeOnDelete: boolean;

function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;

function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;

function RecyclerHasGlobalSettings: boolean;

function RecyclerIsEmpty: boolean; overload;

function RecyclerIsEmpty(Drive: Char): boolean; overload;

function RecyclerGetNumItems: int64; overload;

function RecyclerGetNumItems(Drive: Char): int64; overload;

function RecyclerGetSize: int64; overload;

function RecyclerGetSize(Drive: Char): int64; overload;

function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo; overload;

function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo; overload;

function RecyclerGetCLSID: string;

// Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer

// 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben

// werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da

// unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:

// - RecyclerIsEmpty

// - RecyclerGetNumItems

// - RecyclerGetSize

// - RecyclerGetAPIInfo

function RecyclerQueryFunctionAvailable: boolean;

function RecyclerLibraryVersion: string;

implementation

type

  SHELLSTATE = record

    Flags1: DWORD;

(*

    BOOL fShowAllObjects : 1;

    BOOL fShowExtensions : 1;

    BOOL fNoConfirmRecycle : 1;

    BOOL fShowSysFiles : 1;

    BOOL fShowCompColor : 1;

    BOOL fDoubleClickInWebView : 1;

    BOOL fDesktopHTML : 1;

    BOOL fWin95Classic : 1;

    BOOL fDontPrettyPath : 1;

    BOOL fShowAttribCol : 1; // No longer used, dead bit

    BOOL fMapNetDrvBtn : 1;

    BOOL fShowInfoTip : 1;

    BOOL fHideIcons : 1;

    BOOL fWebView : 1;

    BOOL fFilter : 1;

    BOOL fShowSuperHidden : 1;

    BOOL fNoNetCrawling : 1;

*)

    dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts

    uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts

    // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM

    lParamSort: Integer;

    iSortDirection: Integer;

    version: UINT;

    // new for win2k. need notUsed var to calc the right size of ie4 struct

    // FIELD_OFFSET does not work on bit fields

    uNotUsed: UINT; // feel free to rename and use

    Flags2: DWORD;

(*

    BOOL fSepProcess: 1;

    // new for Whistler.

    BOOL fStartPanelOn: 1;       //Indicates if the Whistler StartPanel mode is ON or OFF.

    BOOL fShowStartPage: 1;      //Indicates if the Whistler StartPage on desktop is ON or OFF.

    UINT fSpareFlags : 13;

*)

  end;

  LPSHELLSTATE = ^SHELLSTATE;

const

  {$IFDEF MSWINDOWS}

    shell32  = 'shell32.dll';

    advapi32 = 'advapi32.dll';

  {$ENDIF}

  {$IFDEF LINUX}

    shell32  = 'libshell32.borland.so';

    advapi32 = 'libwine.borland.so';

  {$ENDIF}

  // Masks for the shellstate

   SSF_SHOWALLOBJECTS  = $00000001;

  SSF_SHOWEXTENSIONS  = $00000002;

  SSF_HIDDENFILEEXTS  = $00000004;

  SSF_SERVERADMINUI   = $00000004;

  SSF_SHOWCOMPCOLOR   = $00000008;

  SSF_SORTCOLUMNS     = $00000010;

  SSF_SHOWSYSFILES    = $00000020;

  SSF_DOUBLECLICKINWEBVIEW = $00000080;

  SSF_SHOWATTRIBCOL   = $00000100;

  SSF_DESKTOPHTML     = $00000200;

  SSF_WIN95CLASSIC    = $00000400;

  SSF_DONTPRETTYPATH  = $00000800;

  SSF_SHOWINFOTIP     = $00002000;

  SSF_MAPNETDRVBUTTON = $00001000;

  SSF_NOCONFIRMRECYCLE = $00008000;

  SSF_HIDEICONS       = $00004000;

  SSF_FILTER          = $00010000;

  SSF_WEBVIEW         = $00020000;

  SSF_SHOWSUPERHIDDEN = $00040000;

  SSF_SEPPROCESS      = $00080000;

  SSF_NONETCRAWLING   = $00100000;

  SSF_STARTPANELON    = $00200000;

  SSF_SHOWSTARTPAGE   = $00400000;

// **********************************************************

// COMPATIBILITY FUNCTIONS

// **********************************************************

{$IFNDEF DEL5UP}

function IncludeTrailingBackslash(str: string): string;

begin

  if Copy(str, length(str), 1) = '\' then    // TODO? Gibt es PathDelim in Delphi 4?

    Result := str

  else

    Result := str + '\';

end;

{$ENDIF}

// **********************************************************

// INTERNALLY USED FUNCTIONS

// **********************************************************

type

  TNibble = $0..$F;

  TBitPos = 0..7;

resourcestring

  LNG_UNEXPECTED_STATE = 'Cannot determinate state of "%s" because of an unknown value in the configuration of your operation system. Please contact the developer of the Recycler Bin Unit and help improving the determination methods!';

  LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';

  LNG_NOT_CALLABLE = '%s not callable';

  LNG_ERROR_CODE = '%s returns error code %s';

function _GetBit(B: Byte; BitPos: TBitPos): boolean; overload;

var

  p: byte;

begin

  p := 1 shl BitPos; // 2 ^ BitPos

  result := B and p = p;

end;

function _GetBit(B: Char; BitPos: TBitPos): boolean; overload;

begin

  result := _GetBit(Ord(B), BitPos);

end;

function _DriveNum(Drive: Char): Byte;

// a->0, ..., z->25

var

  tmp: string;

begin

  tmp := LowerCase(Drive);

  result := Ord(tmp[1])-Ord('a');

end;

function _registryReadDump(AReg: TRegistry; AName: string): string;

const

  // Win2000 RegEdit has set the max input length of a REG_BINARY to $3FFF.

  // Probably its the longest possible binary string and not just a GUI limit.

  BufMax = $3FFF;

var

  buf: array[0..BufMax] of byte;

  i: integer;

  realsize: integer;

begin

  realsize := AReg.ReadBinaryData(AName, buf, SizeOf(buf));

  for i := 0 to realsize-1 do

  begin

    result := result + chr(buf[i]);

  end;

end;

function _LowerNibble(B: Byte): TNibble;

begin

  result := B and 15 {00001111};

end;

(* function _UpperNibble(B: Byte): TNibble;

begin

  result := B and 240 {11110000};

end;

function _MakeByte(UpperNibble, LowerNibble: TNibble): Byte;

begin

  result := LowerNibble + UpperNibble * $10;

end; *)

function _GetStringFromDLL(filename: string; num: integer): string;

const

  // http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp

  MAX_BUF = 4097; // OK?

var

  hLib: THandle;

  buf: array[0..MAX_BUF] of char;

begin

  hLib := LoadLibrary(PChar(filename));

  try

    LoadString(hLib, num, buf, sizeof(buf));

    result := buf;

  finally

    FreeLibrary(hLib);

  end;

end;

// http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html

function _ExpandEnvStr(const szInput: string): string;

const

  MAXSIZE = 32768; // laut PSDK sind 32k das Maximum

begin

  SetLength(Result,MAXSIZE);

  SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),

    @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen

end;

// Beispiele

// Papierkorb                                                 -- Windows 95

// @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000

function _DecodeReferenceString(s: string): string;

var

  dll, id, lang, cache: string;

  sl, sl2: tstringlist;

begin

  if Copy(s, 1, 1) = '@' then

  begin

    // Referenz auf eine DLL

    // @<dll>,-<id>[@<lang>][,<cache>]

    sl := TStringList.Create;

    try

      // '@' am Anfang entfernen

      s := Copy(s, 2, length(s)-1);

      // Nach ',' auftrennen

      // sl[0] --> dll

      // sl[1] --> -id@lang

      // sl[2] --> cache

      sl.CommaText := s;

      if sl.Count > 2 then

      begin

        // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden

        // Ist bei Windows 2000 der Fall

        cache := sl[2];

        result := cache;

        exit;

      end;

      if sl.Count > 1 then

      begin

        dll := sl[0];

        sl2 := TStringList.Create;

        try

          // Nach '@' auftrennen

          // sl2[0] --> id

          // sl2[1] --> lang

          sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);

          id := sl2[0];

          if sl2.Count > 1 then

          begin

            // ToDo: In Zukunft beachten, sofern möglich

            lang := sl2[1];

          end;

          // Umgebungsvariablen erkennen und Minuszeichen entfernen

          result := _GetStringFromDLL(_ExpandEnvStr(dll), -StrToInt(id));

        finally

          sl2.Free;

        end;

      end

      else

      begin

        // Zu wenige Informationen!

        result := '';

      end;

    finally

      sl.Free;

    end;

  end

  else

  begin

    // Kein Hinweis auf eine Referenz

    result := s;

  end;

end;

function _readInt8(const Stream: TStream): byte;

var

  I: integer;

begin

  i := 0;

  Stream.ReadBuffer(i, 1);

  Result := i;

end;

function _readInt32(const Stream: TStream): Longword;

var

  I: integer;

begin

  i := 0;

  Stream.ReadBuffer(i, 4);

  Result := i;

end;

function _readInt64(const Stream: TStream): int64;

var

  I: int64;

begin

  i := 0;

  Stream.ReadBuffer(i, 8);

  Result := i;

end;

function _readChar(const Stream: TStream): char;

var

  C: Char;

begin

  C := #0;

  Stream.ReadBuffer(C, 1);

  Result := C;

end;

function _readNullTerminatedString(const Stream: TStream): String;

var

  S: String;

  C: Char;

begin

  S := '';

  repeat

    Stream.ReadBuffer(C, 1);

    if (C <> #0) then

      S := S + C;

  until C = #0;

  Result := S;

end;

// http://www.delphipraxis.net/post761928.html#761928

function _readNullTerminatedWideString(const Stream: TStream): WideString;

var

  S: WideString;

  WC: WideChar;

begin

  S := '';

  repeat

    Stream.ReadBuffer(WC, 2);

    if (WC <> #0) then

      S := S + WC;

  until WC = #0;

  Result := S;

end;

// http://www.delphipraxis.net/post340194.html#340194

function _nowUTC: TDateTime;

var

  SystemTime: TSystemTime;

begin

  GetSystemTime(SystemTime);

  with SystemTime do

  begin

    Result := EncodeDate(wYear, wMonth, wDay) +

              EncodeTime(wHour, wMinute, wSecond, wMilliseconds);

  end;

end;

{$IFDEF DEL6UP}

function _getGMTDifference(): extended;

begin

  result := - (datetimetounix(_nowUTC())-datetimetounix(Now())) / 3600;

end;

function _fileTimeToDateTime(FileTime: int64): TDateTime;

begin

  // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf

  // UnixTime = 0.0000001 * NTTime + 11644473600

  // This is wrong! The correct formula is:

  // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600

  // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)

  result := unixtodatetime(FileTime div 10000000 - 11644473600 + round(_getGMTDifference() * 3600));

end;

{$ENDIF}

// http://www.delphipraxis.net/post471470.html

function _getAccountSid(const Server, User: WideString; var Sid: PSID): DWORD;

var

  dwDomainSize, dwSidSize: DWord;

  R: LongBool;

  wDomain: WideString;

  Use: DWord;

begin

  Result := 0;

  SetLastError(0);

  dwSidSize := 0;

  dwDomainSize := 0;

  R := LookupAccountNameW(PWideChar(Server), PWideChar(User), nil, dwSidSize,

       nil, dwDomainSize, Use);

  if (not R) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then

  begin

    SetLength(wDomain, dwDomainSize);

    Sid := GetMemory(dwSidSize);

    R := LookupAccountNameW(PWideChar(Server), PWideChar(User), Sid,

         dwSidSize, PWideChar(wDomain), dwDomainSize, Use);

    if not R then

    begin

      FreeMemory(Sid);

      Sid := nil;

    end;

  end

  else

    Result := GetLastError;

end;

// Template:

// http://www.latiumsoftware.com/en/pascal/0014.php

function _getLoginNameW: widestring;

var

  Buffer: array[0..255] of widechar;

  Size: dword;

begin

  Size := 256;

  if GetUserNameW(Buffer, Size) then

    Result := Buffer

  else

    Result := 'User';

end;

function _Dyn_ConvertSidToStringSidA(SID: PSID; var strSID: LPSTR): boolean;

type

  DllReg = function(SID: PSID; var StringSid: LPSTR): Boolean; stdcall;

var

  hDll: THandle;

  dr: DllReg;

begin

  result := false;

  hDll := LoadLibrary(advapi32);

  if hDll <> 0 then

  begin

    @dr := GetProcAddress(hDll, 'ConvertSidToStringSidA');

    if assigned(dr) then

    begin

      result := dr(SID, strSID);

    end;

  end;

end;

// http://www.delphipraxis.net/post471470.html

// Changed

function _getMySID(): string;

var

  SID: PSID;

  strSID: PAnsiChar;

  s: String;

  err: DWORD;

begin

  SID := nil;

  err := _getAccountSid('', _getLoginNameW(), SID);

  if err = 0 then

  begin

    if _Dyn_ConvertSidToStringSidA(SID, strSID) then

      s := string(strSID)

    else

      s := SysErrorMessage(err);

  end

  else

    s := SysErrorMessage(err);

  result := s;

end;

// Originalcode aus http://www.delphipraxis.net/post2933.html

function _DriveExists(DriveByte: Byte): Boolean; overload;

begin

  Result := GetLogicalDrives and (1 shl DriveByte) <> 0;

end;

function _driveExists(Drive: Char): Boolean; overload;

var

  DriveByte: Byte;

  tmp: string;

begin

  // Make drive letter upper case (for older Delphi versions)

  tmp := UpperCase(Drive);

  Drive := tmp[1];

  DriveByte := Ord(Drive) - Ord('A');

  Result := _DriveExists(DriveByte);

end;

function _isFAT(drive: char): boolean;

var

  Dummy2: DWORD;

  Dummy3: DWORD;

  FileSystem: array[0..MAX_PATH] of char;

  VolumeName: array[0..MAX_PATH] of char;

  s: string;

begin

  result := false;

  if _driveExists(drive) then

  begin

    s := drive + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll

    GetVolumeInformation(PChar(s), VolumeName,

      SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem));

    result := uppercase(copy(FileSystem, 0, 3)) = 'FAT';

  end;

end;

// http://www.delphipages.com/tips/thread.cfm?ID=294

// Changed

(* function IsWin95: boolean;

var

  OS: TOSVersionInfo;

begin

  ZeroMemory(@OS, SizeOf(OS));

  OS.dwOSVersionInfoSize := SizeOf(OS);

  GetVersionEx(OS);

  // http://www.gaijin.at/lstwinver.php

  Result := (OS.dwMajorVersion = 4) and (OS.dwMinorVersion <= 3) and

            (OS.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS);

end; *)

// http://www.delphipages.com/tips/thread.cfm?ID=294

// Changed

function _isVista: boolean;