Subversion Repositories delphiutils

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

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

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

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

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

// Revision: 05 JUL 2010                                                          //

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

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

// Successful tested with:                                                        //

// Windows 95b (without IE4 Shell Extensions)                                     //

// Windows 95b (with IE4 Shell Extensions)                                        //

// Windows 98-SE                                                                  //

// Windows XP-SP3                                                                 //

// Windows 2000-SP4                                                               //

// Windows 2003 Server EE SP1                                                     //

// Windows Vista                                                                  //

// Windows 7                                                                      //

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

//                                                                                //

//  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.                                               //

//    - Make it possible to empty the recycle bin of one specific drive!          //

//                                                                                //

//  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?

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!!!

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

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

Es sollte möglich sein, dass ein Laufwerk mehr als 1 Recycler beinhaltet -- behandeln

- Future -

Demoapplikation: Dateien statt 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,

  Messages, BitOps;

type

  EUnknownState = class(Exception);

  EEventCategoryNotDefined = class(Exception);

  EAPICallError = class(Exception);

  PSHQueryRBInfo = ^TSHQueryRBInfo;

  TSHQueryRBInfo = packed record

    cbSize      : dword;

    i64Size     : int64;

    i64NumItems : int64;

  end;

  GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);

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;

function RecyclerShellStateConfirmationDialogEnabled: 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 RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;

function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;

function RecyclerGroupPolicyRecycleBinSize: integer;

function GPBoolToString(value: GPOLICYBOOL): String;

function RecyclerIsPossible(Drive: Char): 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

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

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 (Arguments: %s) returns error code %s';

function _FileSize(FileName: string): int64;

var

  fs: TFileStream;

begin

  fs := TFileStream.Create(FileName, fmOpenRead);

  try

    result := fs.size;

  finally

    fs.free;

  end;

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 _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;

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

// VISTA AND WINDOWS 7 FUNCTIONS, INTERNAL USED

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

const

  vista_valid_index_size = $220; // 544

function _isFileVistaRealfile(filename: string): boolean;

begin

  result := uppercase(copy(extractfilename(filename), 0, 2)) = '$R';

end;

function _isFileVistaIndexfile(filename: string): boolean;

begin

  result := uppercase(copy(extractfilename(filename), 0, 2)) = '$I';