WebSVN – recyclebinunit – Diff – /trunk/Recycle Bin Unit/RecyclerFunctions.pas


 
// ********************************************************************************
// **** ATTENTION! This unit is not developed anymore.                        *****
// **** Please use the new version RecBinUnit2.pas , which is Object-oriented *****
// ********************************************************************************
 
////////////////////////////////////////////////////////////////////////////////////
// RECYCLE-BIN-FUNCTIONS BY DANIEL MARSCHALL                                      //
// E-MAIL: info@daniel-marschall.de                                               //
// WEB:    www.daniel-marschall.de                                                //
////////////////////////////////////////////////////////////////////////////////////
// Revision: 01 NOV 2016                                                          //
// This unit is freeware, but please link to my website if you are using it!      //
////////////////////////////////////////////////////////////////////////////////////
// Successfully tested with:                                                      //
// Windows 95b (without IE4 Shell Extensions)                                     //
// Windows 95b (with IE4 Shell Extensions)                                        //
// Windows 98-SE                                                                  //
// Windows NT4 SP6                                                                //
// Windows XP-SP3                                                                 //
// Windows 2000-SP4                                                               //
// Windows 2003 Server EE SP1                                                     //
// Windows Vista                                                                  //
// Windows 7                                                                      //
////////////////////////////////////////////////////////////////////////////////////
// DOES **NOT** WORK WITH "VERSION 2" INDEX FILES USED IN LATER VERSIONS OF WIN10 //
// USE RECYCLE BIN UNIT V2 INSTEAD!                                               //
////////////////////////////////////////////////////////////////////////////////////
//                                                                                //
//  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?                                                          //
//    - Win7 : Drive GUIDs                                                        //
//    - Win7 : Absolute vs. Relative size limitations                             //
//    - WideString-Support (input/output)                                         //
//    - 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?       //
//                                                                                //
//  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 Ideas ===
 
- Demoapplikation: Dateien statt Text als Explorer-Like (TListView)?
- 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.
- copy/move files from recyclebin
 
*)
 
// 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 _DeleteDirectory(const Name: string): boolean;
var
  F: TSearchRec;
begin
  result := true;
  if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then
  begin
    try
      repeat
        if (F.Attr and faDirectory <> 0) then
        begin
          if (F.Name <> '.') and (F.Name <> '..') then
          begin
            result := result and _DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);
          end;
        end
        else
        begin
          if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;
        end;
      until FindNext(F) <> 0;
    finally
      FindClose(F);
    end;
    if not RemoveDir(Name) then result := false;
  end;
end;
 
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;
 
const
  UNLEN = 256; // lmcons.h
 
// Template:
// http://www.latiumsoftware.com/en/pascal/0014.php
function _getLoginNameW: widestring;
var
  Buffer: array[0..UNLEN] of widechar;
  Size: DWORD;
begin
  Size := SizeOf(Buffer);
  if GetUserNameW(Buffer, Size) then
    Result := Buffer
  else
    Result := 'User';
end;
 
function _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;
 
const
  winternl_lib = 'Ntdll.dll';
 
type
  USHORT = Word;
  PWSTR = PWidechar;
  PCWSTR = PWideChar;
 
   NTSTATUS = Longword;
 
  _UNICODE_STRING = record
    Length: USHORT;
    MaximumLength: USHORT;
    Buffer: PWSTR;
  end;
  UNICODE_STRING = _UNICODE_STRING;
  PUNICODE_STRING = ^UNICODE_STRING;
 
function _RtlConvertSidToUnicodeString(
  UnicodeString: PUNICODE_STRING;
  Sid: PSID;
  AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
type
  DllReg = function(UnicodeString: PUNICODE_STRING;
  Sid: PSID;
  AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
var
  hDll: THandle;
  dr: DllReg;
begin
  result := $FFFFFFFF;
  hDll := LoadLibrary(winternl_lib);
  if hDll = 0 then Exit;
  try
    @dr := GetProcAddress(hDll, 'RtlConvertSidToUnicodeString');
    if not Assigned(dr) then Exit;
    result := dr(UnicodeString, Sid, AllocateDestinationString);
  finally
    FreeLibrary(hDll);
  end;
end;
 
procedure _RtlFreeUnicodeString(UnicodeString: PUNICODE_STRING); stdcall;
type
  DllReg = procedure(UnicodeString: PUNICODE_STRING); stdcall;
var
  hDll: THandle;
  dr: DllReg;
begin
  hDll := LoadLibrary(winternl_lib);
  if hDll = 0 then Exit;
  try
    @dr := GetProcAddress(hDll, 'RtlFreeUnicodeString');
    if not Assigned(dr) then Exit;
    dr(UnicodeString);
  finally
    FreeLibrary(hDll);
  end;
end;
 
function _NT_SidToString(SID: PSID; var strSID: string): boolean;
var
  pus: PUNICODE_STRING;
  us: UNICODE_STRING;
begin
  pus := @us;
  result := _RtlConvertSidToUnicodeString(pus, SID, true) = 0;
  if not result then Exit;
  strSID := pus^.Buffer;
  UniqueString(strSID);
  _RtlFreeUnicodeString(pus);
  result := true;
end;
 
// Source: http://www.delphipraxis.net/post471470.html
// Modified
function _getMySID(): string;
var
  SID: PSID;
  strSID: PAnsiChar;
  err: DWORD;
begin
  SID := nil;
 
  err := _getAccountSid('', _getLoginNameW(), SID);
  try
    if err > 0 then
    begin
      EAPICallError.Create('_getAccountSid:' + SysErrorMessage(err));
      Exit;
    end;
 
    if _ConvertSidToStringSidA(SID, strSID) then
    begin
      result := string(strSID);
      Exit;
    end;
 
    if _NT_SidToString(SID, result) then Exit;
 
    EAPICallError.Create('_getMySID:' + SysErrorMessage(err));
  finally
    if Assigned(SID) then FreeMemory(SID);
  end;
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';
end;
 
function _isFileVistaNamed(filename: string): boolean;
begin
  result := _isFileVistaIndexfile(filename) or
            _isFileVistaRealfile(filename);
end;
 
function _VistaChangeRealfileToIndexfile(realfile: string): string;
begin
  if _isFileVistaRealfile(realfile) then
  begin
    result := extractfilepath(realfile)+'$I'+
      copy(extractfilename(realfile), 3, length(extractfilename(realfile))-2);
  end
  else
    result := realfile; // ignore, even if it is not a vista recycle-file
end;
 
function _VistaChangeIndexfileToRealfile(indexfile: string): string;
begin
  if _isFileVistaIndexfile(indexfile) then
  begin
    result := extractfilepath(indexfile)+'$R'+
      copy(extractfilename(indexfile), 3, length(extractfilename(indexfile))-2);
  end
  else
    result := indexfile; // ignore, even if it is not a vista recycle-file
end;
 
procedure _VistaListIndexes(recyclerpath: string; result: TStringList);
var
  sr: TSearchRec;
  r: Integer;
  tmp: string;
begin
  tmp := recyclerpath;
  tmp := IncludeTrailingBackslash(tmp);
 
  if not directoryexists(tmp) then exit;
 
  r := FindFirst(tmp+PathDelim + '$I*', faAnyFile, sr);
  while r = 0 do
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
    begin
      if sr.Size = vista_valid_index_size then
      begin
        result.Add(copy(sr.name, 3, length(sr.name)-2));
      end;
    end;
    r := FindNext(sr);
  end;
 
  FindClose(sr);
end;
 
function _VistaCurrentFilename(infofilename: string): string;
begin
  result := extractfilename(infofilename);
 
  if _isFileVistaRealfile(result) then
  begin
    exit;
  end;
 
  if _isFileVistaIndexfile(result) then
  begin
    result := _VistaChangeIndexfileToRealfile(result);
    exit;
  end;
 
  result := copy(result, 3, length(result)-2);
  result := '$R'+result;
end;
 
function _VistaGetSourceDrive(infofile: string): char;
var
  fs: TFileStream;
  tmp: string;
const
  drive_vista_position = $18;
begin
  result := #0;
 
  tmp := infofile;
  tmp := _VistaChangeRealfileToIndexfile(tmp);
  if not fileexists(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(drive_vista_position, soFromBeginning);
    result := _readChar(fs);
  finally
    fs.free;
  end;
end;
 
{$IFDEF DEL6UP}
function _VistaGetDateTime(infofile: string): TDateTime;
var
  fs: TFileStream;
  tmp: string;
const
  timestamp_vista_position = $10;
begin
  result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
 
  tmp := infofile;
  tmp := _VistaChangeRealfileToIndexfile(tmp);
  if not fileexists(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(timestamp_vista_position, soFromBeginning);
    result := _fileTimeToDateTime(_readInt64(fs));
  finally
    fs.free;
  end;
end;
{$ENDIF}
 
function _VistaGetSourceUnicode(infofile: string): string;
var
  fs: TFileStream;
  tmp: string;
const
  unicode_vista_position = $18;
begin
  result := '';
 
  tmp := infofile;
  tmp := _VistaChangeRealfileToIndexfile(tmp);
  if not fileexists(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(unicode_vista_position, soFromBeginning);
    result := _readNullTerminatedWideString(fs);
  finally
    fs.free;
  end;
end;
 
function _VistaOriginalSize(infofile: string): integer;
var
  fs: TFileStream;
  tmp: string;
const
  size_vista_position = $8;
begin
  result := -1;
 
  tmp := infofile;
  tmp := _VistaChangeRealfileToIndexfile(tmp);
  if not fileexists(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(size_vista_position, soFromBeginning);
    result := _readInt32(fs);
  finally
    fs.free;
  end;
end;
 
function _checkInfo1or2File(filename: string): boolean;
var
  fs: TStream;
  record_length: integer;
const
  length_position = $C;
  empty_size = 20;
begin
  fs := TFileStream.Create(filename, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    // Check the file length
    if record_length = 0 then
      result := false
    else
      result := (fs.size - empty_size) mod record_length = 0;
  finally
    fs.free;
  end;
end;
 
function _VistaIsValid(infofile: string): boolean;
var
  tmp: string;
begin
  result := false;
 
  tmp := infofile;
  tmp := _VistaChangeRealfileToIndexfile(tmp);
  if not fileexists(tmp) then exit;
 
  // Check the file length
  result := _FileSize(tmp) = vista_valid_index_size;
end;
 
// **********************************************************
// PUBLIC FUNCTIONS
// **********************************************************
 
{$IFDEF DEL6UP}
 
function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
begin
  result := RecyclerGetDateTime(InfofileOrRecycleFolder, '');
end;
 
function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
begin
  result := RecyclerGetDateTime(drive, '', fileid);
end;
 
function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  result := RecyclerGetDateTime(infofile, fileid);
end;
 
function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
const
  length_position = $C;
  unique_index_position = $118;
  timestamp_position = $120;
begin
  // FILETIME does start at 01.01.1601 00:00:00 (GMT)
  result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    result := _VistaGetDateTime(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      result := _VistaGetDateTime(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    i := -1;
    repeat
      inc(i);
      if unique_index_position+i*record_length > fs.size then break;
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
      if inttostr(_readInt32(fs)) = id then
      begin
        fs.seek(timestamp_position+i*record_length, soFromBeginning);
        result := _fileTimeToDateTime(_readInt64(fs));
        break;
      end;
      until false;
  finally
    fs.free;
  end;
end;
 
{$ENDIF}
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
begin
  result := RecyclerGetSourceUnicode(InfofileOrRecycleFolder, '');
end;
 
function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
begin
  result := RecyclerGetSourceUnicode(drive, '', fileid);
end;
 
function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
var
  infofile: string;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    infofile := RecyclerGetPath(drive, UserSID, true, fileid);
    result := RecyclerGetSourceUnicode(infofile, fileid);
  end
  else
  begin
    // Windows 9x does not support unicode
    result := RecyclerGetSource(drive, UserSID, fileid);
  end;
end;
 
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
const
  length_position = $C;
  unique_index_position = $118;
  unicode_source_position = $12C;
begin
  result := '';
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    // Vista only gives unicode names
    result := _VistaGetSourceUnicode(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      // Vista only gives unicode names
      result := _VistaGetSourceUnicode(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    if record_length <> $118 then
    begin
      // Windows NT
      i := -1;
      repeat
        inc(i);
        if unique_index_position+i*record_length > fs.size then break;
        fs.seek(unique_index_position+i*record_length, soFromBeginning);
        if inttostr(_readInt32(fs)) = id then
        begin
          fs.seek(unicode_source_position+i*record_length, soFromBeginning);
          result := _readNullTerminatedWideString(fs);
          break;
        end;
      until false;
    end;
  finally
    fs.free;
  end;
 
  if record_length = $118 then
  begin
    // Windows 9x has no unicode support
    result := RecyclerGetSource(tmp, id);
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
begin
  result := RecyclerGetSource(InfofileOrRecycleFolder, '');
end;
 
function RecyclerGetSource(drive: char; fileid: string): string; overload;
begin
  result := RecyclerGetSource(drive, '', fileid);
end;
 
function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  result := RecyclerGetSource(infofile, fileid);
end;
 
function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
  alternativ: string;
const
  length_position = $C;
  unique_index_position = $118;
  source_position = $14;
begin
  result := '';
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    // Vista only gives unicode names
    result := _VistaGetSourceUnicode(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      // Vista only gives unicode names
      result := _VistaGetSourceUnicode(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    i := -1;
    repeat
      inc(i);
      if unique_index_position+i*record_length > fs.size then break;
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
      if inttostr(_readInt32(fs)) = id then
      begin
        fs.seek(source_position+i*record_length, soFromBeginning);
        alternativ := _readChar(fs);
 
        if alternativ = #0 then
        begin
          fs.seek(source_position+i*record_length+1, soFromBeginning);
          result := _readNullTerminatedString(fs);
        end
        else
        begin
          fs.seek(source_position+i*record_length, soFromBeginning);
          result := _readNullTerminatedString(fs);
        end;
 
        break;
      end;
    until false;
  finally
    fs.free;
  end;
 
  // In some cases the ansi-source-name is [Null]:\...\
  if alternativ = #0 then
  begin
    result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, id) + result;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
begin
  RecyclerListIndexes(drive, '', result);
end;
 
procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, false);
  RecyclerListIndexes(infofile, result);
end;
 
procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
const
  length_position = $C;
  unique_index_position = $118;
begin
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    _VistaListIndexes(extractfilepath(tmp), result);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'INFO2') then     tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then tmp := tmp+'INFO'
    else
    begin
      // Last try: is it a vista-directory?
      _VistaListIndexes(tmp, result);
      exit;
    end;
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    i := -1;
    repeat
      inc(i);
      if unique_index_position+i*record_length > fs.size then break;
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
 
      result.Add(inttostr(_readInt32(fs)));
    until false;
  finally
    fs.free;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
begin
  result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, '');
end;
 
function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
begin
  result := RecyclerGetSourceDrive(drive, '', fileid);
end;
 
function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  result := RecyclerGetSourceDrive(infofile, fileid);
end;
 
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
const
  length_position = $C;
  unique_index_position = $118;
  source_drive_position = $11C;
begin
  result := #0;
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    result := _VistaGetSourceDrive(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      result := _VistaGetSourceDrive(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    i := -1;
    repeat
      inc(i);
      if unique_index_position+i*record_length > fs.size then break;
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
      if inttostr(_readInt32(fs)) = id then
      begin
        fs.seek(source_drive_position+i*record_length, soFromBeginning);
        result := chr(ord('A') + _readInt8(fs));
        break;
      end;
    until false;
  finally
    fs.free;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
begin
  result := RecyclerOriginalSize(InfofileOrRecycleFolder, '');
end;
 
function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
begin
  result := RecyclerOriginalSize(drive, '', fileid);
end;
 
function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  result := RecyclerOriginalSize(infofile, fileid);
end;
 
function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
var
  fs: TFileStream;
  i, record_length: integer;
  tmp: string;
const
  length_position = $C;
  unique_index_position = $118;
  original_size_position = $128;
begin
  result := -1;
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    result := _VistaOriginalSize(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      result := _VistaOriginalSize(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  if not fileexists(tmp) then exit;
  if not RecyclerIsValid(tmp) then exit;
 
  fs := TFileStream.Create(tmp, fmOpenRead);
  try
    fs.seek(length_position, soFromBeginning);
    record_length := _readInt32(fs);
 
    i := -1;
    repeat
      inc(i);
      if unique_index_position+i*record_length > fs.size then break;
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
      if inttostr(_readInt32(fs)) = id then
      begin
        fs.seek(original_size_position+i*record_length, soFromBeginning);
        result := _readInt32(fs);
        break;
      end;
    until false;
  finally
    fs.free;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerIsValid(drive: char): boolean; overload;
begin
  // Bei Vista und Win2003 (VM) erhalte ich bei LW A: die Meldung
  // "c0000013 Kein Datenträger". Exception Abfangen geht nicht.
  // Daher erstmal überprüfen, ob Laufwerk existiert.
  result := false;
  if not RecyclerIsPossible(drive) then exit;
 
  result := RecyclerIsValid(drive, '');
end;
 
function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
var
  infofile: string;
begin
  // Anmerkung siehe oben.
  result := false;
  if not RecyclerIsPossible(drive) then exit;
 
  infofile := RecyclerGetPath(drive, UserSID, false);
  result := RecyclerIsValid(infofile);
end;
 
function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
var
  tmp: string;
  x: TStringList;
  i: integer;
  eine_fehlerhaft: boolean;
begin
  result := false;
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    result := _VistaIsValid(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'INFO2') then
    begin
      result := _checkInfo1or2File(tmp+'INFO2');
    end;
 
    if not result and fileexists(tmp+'INFO') then
    begin
      result := _checkInfo1or2File(tmp+'INFO');
    end;
 
    if not result then
    begin
      // Complete vista-directory declared?
      eine_fehlerhaft := false;
      x := TStringList.Create;
      try
        _VistaListIndexes(tmp, x);
        for i := 0 to x.Count - 1 do
        begin
          if not _VistaIsValid(tmp+'$I'+x.Strings[i]) then
          begin
            eine_fehlerhaft := true;
          end;
        end;
      finally
        x.Free;
      end;
      result := not eine_fehlerhaft;
    end;
  end;
 
  if not fileexists(tmp) then exit;
 
  result := _checkInfo1or2File(tmp);
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
begin
  result := RecyclerCurrentFilename(InfofileOrRecycleFolder, '');
end;
 
function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
begin
  result := RecyclerCurrentFilename(drive, '', fileid);
end;
 
function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
var
  infofile: string;
begin
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  result := RecyclerCurrentFilename(infofile, fileid);
end;
 
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
var
  a, c: string;
  tmp: string;
begin
  result := '';
 
  tmp := InfofileOrRecycleFolder;
 
  if _isFileVistaNamed(tmp) then
  begin
    result := _VistaCurrentFilename(tmp);
    exit;
  end;
 
  {$IFDEF allow_all_filenames}
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
  begin
    if fileexists(extractfilepath(tmp)+'INFO2') then
      tmp := extractfilepath(tmp)+'INFO2'
    else if fileexists(extractfilepath(tmp)+'INFO') then
      tmp := extractfilepath(tmp)+'INFO';
  end;
  {$ENDIF}
 
  if directoryexists(tmp) then
  begin
    tmp := IncludeTrailingBackslash(tmp);
 
    if fileexists(tmp+'$I'+id) then
    begin
      result := _VistaCurrentFilename(tmp+'$I'+id);
      exit;
    end
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  end;
 
  a := RecyclerGetSourceDrive(tmp, id);
  c := extractfileext(RecyclerGetSourceUnicode(tmp, id));
  if (a <> '') then
  begin
    result := 'D' + a + id + c;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, fileid, sl);
    if sl.Count > 0 then
      result := ExtractFilePath(sl.Strings[0])
    else
      result := '';
  finally
    sl.free;
  end;
end;
 
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, sl);
    if sl.Count > 0 then
      result := ExtractFilePath(sl.Strings[0])
    else
      result := '';
  finally
    sl.free;
  end;
end;
 
function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RecyclerGetInfofiles(drive, IncludeInfofile, sl);
    if sl.Count > 0 then
      result := ExtractFilePath(sl.Strings[0])
    else
      result := '';
  finally
    sl.free;
  end;
end;
 
function RecyclerGetPath(drive: char; UserSID: string): string; overload;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RecyclerGetInfofiles(drive, UserSID, sl);
    if sl.Count > 0 then
      result := ExtractFilePath(sl.Strings[0])
    else
      result := '';
  finally
    sl.free;
  end;
end;
 
function RecyclerGetPath(drive: char): string; overload;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RecyclerGetInfofiles(drive, sl);
    if sl.Count > 0 then
      result := ExtractFilePath(sl.Strings[0])
    else
      result := '';
  finally
    sl.free;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
var
  dir: string;
begin
  // Find recyclers from Windows Vista or higher
 
  if _isFAT(drive) then
  begin
    dir := drive + DriveDelim + PathDelim + '$recycle.bin' + PathDelim;
    if IncludeInfofile and (fileid <> '') then
    begin
      if fileExists(dir + '$I'+fileid) then
      begin
        result.Add(dir + '$I'+fileid);
      end;
    end
    else
    begin
      if directoryExists(dir) then
      begin
        result.Add(dir);
      end;
    end;
  end
  else
  begin
    if UserSID <> '' then
    begin
      dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+UserSID+PathDelim;
      if IncludeInfofile and (fileid <> '') then
      begin
        if fileExists(dir + '$I'+fileid) then
        begin
          result.Add(dir + '$I'+fileid);
        end;
      end
      else
      begin
        if directoryExists(dir) then
        begin
          result.Add(dir);
        end;
      end;
    end
    else
    begin
      // TODO: aber vielleicht möchte man die Papierkörbe aller Benutzer (also aller SIDs) finden!!!
      dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+_getMySID()+PathDelim;
      if IncludeInfofile and (fileid <> '') then
      begin
        if fileExists(dir + '$I'+fileid) then
        begin
          result.Add(dir + '$I'+fileid);
        end;
      end
      else
      begin
        if directoryExists(dir) then
        begin
          result.Add(dir);
        end;
      end;
    end;
  end;
 
  // Find recyclers from Windows before Vista
 
  if _isFAT(drive) then
  begin
    dir := drive + DriveDelim + PathDelim + 'Recycled' + PathDelim;
    if IncludeInfofile then
    begin
      // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them)
      if fileExists(dir + 'INFO2') then
        result.Add(dir + 'INFO2'); // Windows 95 with Internet Explorer 4 Extension or higher Windows versions
      if fileExists(dir + 'INFO') then
        result.Add(dir + 'INFO'); // Windows 95 native
    end
    else
    begin
      if directoryExists(dir) then
        result.Add(dir);
    end;
  end
  else
  begin
    if UserSID <> '' then
    begin
      dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+UserSID+PathDelim;
      if IncludeInfofile then
      begin
        if fileExists(dir + 'INFO2') then
          result.Add(dir + 'INFO2');
        if fileExists(dir + 'INFO') then
          result.Add(dir + 'INFO'); // Windows NT 4
      end
      else
      begin
        if directoryExists(dir) then
          result.Add(dir);
      end;
    end
    else
    begin
      dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+_getMySID()+PathDelim;
      if IncludeInfofile then
      begin
        if fileExists(dir + 'INFO2') then
          result.Add(dir + 'INFO2');
        if fileExists(dir + 'INFO') then
          result.Add(dir + 'INFO'); // Windows NT 4
      end
      else
      begin
        if directoryExists(dir) then
          result.Add(dir);
      end;
    end;
  end;
end;
 
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
begin
  RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, '', result);
end;
 
procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
begin
  RecyclerGetInfofiles(drive, '', IncludeInfofile, '', result);
end;
 
procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
begin
  RecyclerGetInfofiles(drive, UserSID, false, '', result);
end;
 
procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
begin
  RecyclerGetInfofiles(drive, '', false, '', result);
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
begin
  result := RecyclerGetPath(drive, UserSID, false, fileid) +
    RecyclerCurrentFilename(drive, UserSID, fileid);
end;
 
function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
begin
  result := RecyclerCurrentFilenameAndPath(drive, '', fileid);
end;
 
function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
begin
  if RecyclerIsValid(InfofileOrRecycleFolder) then
  begin
    result := extractfilepath(InfofileOrRecycleFolder) +
      RecyclerCurrentFilename(InfofileOrRecycleFolder, id);
  end
  else
    result := '';
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
var
  tmp: string;
begin
  tmp := RecyclerCurrentFilenameAndPath(drive, UserSID, fileid);
  if fileexists(tmp) then
  begin
    deletefile(tmp);
    result := fileexists(tmp);
  end
  else
  begin
    directoryexists(tmp);
    result := directoryexists(tmp);
  end;
end;
 
function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
begin
  result := RecyclerRemoveItem(drive, '', fileid);
end;
 
function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
var
  tmp: string;
begin
  tmp := RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder, id);
  if fileexists(tmp) then
  begin
    deletefile(tmp);
    result := fileexists(tmp);
  end
  else
  begin
    _DeleteDirectory(tmp);
    result := directoryexists(tmp);
  end;
end;
 
procedure RecyclerGetAllRecyclerDrives(result: TStringList);
var
  Drive: char;
begin
  for Drive := 'A' to 'Z' do
  begin
    if RecyclerIsPossible(Drive) and RecyclerIsValid(Drive) then
    begin
      result.Add(Drive);
    end;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
// http://www.dsdt.info/tipps/?id=176
function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
type
  TSHEmptyRecycleBin = function (Wnd: HWND;
                                 pszRootPath: PChar;
                                 dwFlags: DWORD):
                                 HRESULT; stdcall;
var
  PSHEmptyRecycleBin: TSHEmptyRecycleBin;
  LibHandle: THandle;
const
  C_SHEmptyRecycleBinA = 'SHEmptyRecycleBinA';
begin
  result := true;
  LibHandle := LoadLibrary(shell32) ;
  try
    if LibHandle <> 0 then
    begin
      @PSHEmptyRecycleBin:= GetProcAddress(LibHandle, C_SHEmptyRecycleBinA);
      if @PSHEmptyRecycleBin <> nil then
      begin
        PSHEmptyRecycleBin(hInstance, nil, flags);
      end
      else
        result := false;
    end
    else
      result := false;
  finally
    @PSHEmptyRecycleBin := nil;
    FreeLibrary(LibHandle);
  end;
end;
 
function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
const
  SHERB_NOCONFIRMATION = $00000001;
  SHERB_NOPROGRESSUI   = $00000002;
  SHERB_NOSOUND        = $00000004;
var
  flags: cardinal;
begin
  flags := 0;
 
  if not progress then
    flags := flags or SHERB_NOPROGRESSUI;
  if not confirmation then
    flags := flags or SHERB_NOCONFIRMATION;
  if not sound then
    flags := flags or SHERB_NOSOUND;
 
  result := RecyclerEmptyRecycleBin(flags);
end;
 
////////////////////////////////////////////////////////////////////////////////
 
// Template
// http://www.dsdt.info/tipps/?id=116
function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
var
  Operation: TSHFileOpStruct;
begin
  with Operation do
  begin
    Wnd := hInstance; // OK?
    wFunc := FO_DELETE;
    pFrom := PChar(FileOrFolder + #0);
    pTo := nil;
    fFlags := FOF_ALLOWUNDO;
    if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
  end;
  Result := SHFileOperation(Operation) = 0;
end;
 
function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
begin
  result := RecyclerAddFileOrFolder(FileOrFolder, false);
end;
 
function RecyclerConfirmationDialogEnabled: boolean;
var
  gp: GPOLICYBOOL;
begin
  gp := RecyclerGroupPolicyConfirmFileDelete;
  if gp <> gpUndefined then
  begin
    result := gp = gpEnabled;
  end
  else
  begin
    result := RecyclerShellStateConfirmationDialogEnabled;
  end;
end;
 
function RecyclerShellStateConfirmationDialogEnabled: boolean;
type
  TSHGetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD) stdcall;
const
  C_SHGetSettings = 'SHGetSettings';
var
  lpss: SHELLSTATE;
  bNoConfirmRecycle: boolean;
 
  PSHGetSettings: TSHGetSettings;
  RBHandle: THandle;
 
  reg: TRegistry;
  rbuf: array[0..255] of byte;
begin
  PSHGetSettings := nil;
  result := false; // Avoid warning message
 
  RBHandle := LoadLibrary(shell32);
  if(RBHandle <> 0) then
  begin
    PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings);
    if (@PSHGetSettings = nil) then
    begin
      FreeLibrary(RBHandle);
      RBHandle := 0;
    end;
  end;
 
  if (RBHandle <> 0) and (Assigned(PSHGetSettings)) then
  begin
    ZeroMemory(@lpss, SizeOf(lpss));
    PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE);
    // bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle
    bNoConfirmRecycle := GetByteBit(lpss.Flags1, 2);
 
    result := not bNoConfirmRecycle;
  end
  else
  begin
    reg := TRegistry.Create;
    try
      // API function call failed. Probably because Windows is too old.
      // Try to read out from registry.
      // The 3rd bit of the 5th byte of "ShellState" is the value
      // of "fNoConfirmRecycle".
 
      reg.RootKey := HKEY_CURRENT_USER;
      if (reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer')) then
      begin
        ZeroMemory(@rbuf, SizeOf(rbuf));
        reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf));
 
        // Lese 3tes Bit vom 5ten Byte
        // bNoConfirmRecycle := ((rbuf[4] and 4) = 4);
        bNoConfirmRecycle := GetByteBit(rbuf[4], 2);
        result := not bNoConfirmRecycle;
 
        reg.CloseKey;
      end
      else
      begin
        raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]);
      end;
    finally
      reg.Free;
    end;
  end;
 
  if (RBHandle <> 0) then FreeLibrary(RBHandle);
end;
 
procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
type
  TSHGetSetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL) stdcall;
const
  C_SHGetSetSettings = 'SHGetSetSettings';
var
  lpss: SHELLSTATE;
 
  PSHGetSetSettings: TSHGetSetSettings;
  RBHandle: THandle;
 
  reg: TRegistry;
  rbuf: array[0..255] of byte;
 
  //dwResult: DWORD;
  lpdwResult: PDWORD_PTR;
begin
  PSHGetSetSettings := nil;
  lpdwResult := nil;
 
  RBHandle := LoadLibrary(shell32);
  if(RBHandle <> 0) then
  begin
    PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
    if (@PSHGetSetSettings = nil) then
    begin
      FreeLibrary(RBHandle);
      RBHandle := 0;
    end;
  end;
 
  if (RBHandle <> 0) and (Assigned(PSHGetSetSettings)) then
  begin
    ZeroMemory(@lpss, SizeOf(lpss));
    PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get
    lpss.Flags1 := SetByteBit(lpss.Flags1, 2, NewSetting);
    PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
 
    SendMessageTimeout (
      HWND_BROADCAST, WM_SETTINGCHANGE,
      0, lParam (pChar ('ShellState')),
      SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
    );
  end
  else
  begin
    reg := TRegistry.Create;
    try
      // API function call failed. Probably because Windows is too old.
      // Try to read out from registry.
      // The 3rd bit of the 5th byte of "ShellState" is the value
      // of "fNoConfirmRecycle".
 
      reg.RootKey := HKEY_CURRENT_USER;
      if (reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false)) then
      begin
        ZeroMemory(@rbuf, SizeOf(rbuf));
        reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get
        rbuf[4] := SetByteBit(rbuf[4], 2, NewSetting);
        reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
 
        SendMessageTimeout (
          HWND_BROADCAST, WM_SETTINGCHANGE,
          0, lParam (pChar ('ShellState')),
          SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
        );
 
        reg.CloseKey;
      end
      else
      begin
        raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSetSettings])]);
      end;
    finally
      reg.Free;
    end;
  end;
 
  if (RBHandle <> 0) then FreeLibrary(RBHandle);
end;
 
function RecyclerGetCurrentIconString: string;
begin
  if RecyclerIsEmpty then
    result := RecyclerGetEmptyIconString
  else
    result := RecyclerGetFullIconString;
end;
 
function RecyclerGetDefaultIconString: string;
var
  reg: TRegistry;
begin
  // Please note: The "default" icon is not always the icon of the
  // current recycle bin in its current state (full, empty)
  // At Windows 95b, the registry value actually did change every time the
  // recycle bin state did change, but at Windows 2000 I could not see any
  // update, even after reboot. So, the registry value is possible fixed as
  // default = empty on newer OS versions.
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
    begin
      result := reg.ReadString('');
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetEmptyIconString: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
    begin
      result := reg.ReadString('Empty');
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetFullIconString: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
    begin
      result := reg.ReadString('Full');
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetName: string;
var
  reg: TRegistry;
begin
  // Windows 95b:
  // Change of CLSID\{645FF040-5081-101B-9F08-00AA002F954E} will change the desktop name of the recycle bin.
 
  // Windows 2000: If LocalizedString is available, the 3rd argument will be parsed
  // (if the third argument will removed, it will be read out from the DLL resource string automatically)
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
    begin
      if reg.ValueExists('LocalizedString') then
      begin
        result := reg.ReadString('LocalizedString');
        result := _DecodeReferenceString(result);
      end
      else
      begin
        result := reg.ReadString('');
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetInfoTip: string;
var
  reg: TRegistry;
begin
  // Not available in some older versions of Windows
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
    begin
      result := reg.ReadString('InfoTip');
      result := _DecodeReferenceString(result);
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetIntroText: string;
var
  reg: TRegistry;
begin
  // Not available in some older versions of Windows
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
    begin
      result := reg.ReadString('IntroText');
      result := _DecodeReferenceString(result);
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerEmptyEventGetName: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('AppEvents\EventLabels\EmptyRecycleBin') then
    begin
      result := reg.ReadString('');
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerEmptyEventGetCurrentSound: string;
begin
  result := RecyclerEmptyEventGetSound('.Current');
end;
 
function RecyclerEmptyEventGetDefaultSound: string;
begin
  result := RecyclerEmptyEventGetSound('.Default');
end;
 
procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
    begin
      reg.GetKeyNames(AStringList);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerEmptyEventGetSound(ACategory: string): string;
var
  reg: TRegistry;
resourcestring
  LNG_SND_EVENT_CAT_ERROR = 'The category "%s" is not available for the notification event "%s".';
begin
  // Outputs an filename or empty string for no sound defined.
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
    begin
      if reg.OpenKeyReadOnly(ACategory) then
      begin
        result := reg.ReadString('');
        reg.CloseKey;
      end
      else
        raise EEventCategoryNotDefined.CreateFmt(LNG_SND_EVENT_CAT_ERROR, [ACategory, 'EmptyRecycleBin']);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGlobalGetPercentUsage: integer;
var
  reg: TRegistry;
  dump: string;
const
  RES_DEFAULT = 10;
begin
  result := -1;
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
 
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.ValueExists('Percent') then
      begin
        // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 
        result := reg.ReadInteger('Percent');
      end
      else if reg.ValueExists('PurgeInfo') then
      begin
        // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
        dump := _registryReadDump(reg, 'PurgeInfo');
        result := Ord(dump[63]);
      end
      else
      begin
        // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
 
        result := RES_DEFAULT; // Standardeinstellung bei Windows
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerSpecificGetPercentUsage(Drive: Char): integer;
var
  reg: TRegistry;
  dump: string;
const
  RES_DEFAULT = 10;
begin
  result := -1;
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
 
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.OpenKeyReadOnly(Drive) then
      begin
        if reg.ValueExists('Percent') then
        begin
          // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 
          result := reg.ReadInteger('Percent');
        end
        else
        begin
          result := RES_DEFAULT;
        end;
        reg.CloseKey;
      end
      else
      begin
        if reg.ValueExists('PurgeInfo') then
        begin
          // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
          dump := _registryReadDump(reg, 'PurgeInfo');
 
          // NOT tested, only theoretical! My idea about the possible structure is:
          // 0x08 = Drive A
          // 0x0a = Drive B
          // 0x0c = Drive C (validated)
          // 0x0e = Drive D
          // ...
 
          result := Ord(dump[9+_DriveNum(Drive)*2]);
        end
        else
        begin
          // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
 
          result := RES_DEFAULT; // Standardeinstellung bei Windows
        end;
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;
var
  gpSetting: integer;
begin
  gpSetting := RecyclerGroupPolicyRecycleBinSize;
  if gpSetting <> -1 then
    result := gpSetting
  else if RecyclerHasGlobalSettings then
    result := RecyclerGlobalGetPercentUsage
  else
    result := RecyclerSpecificGetPercentUsage(Drive);
end;
 
function RecyclerGlobalIsNukeOnDelete: boolean;
var
  reg: TRegistry;
  dump: AnsiString;
const
  RES_DEFAULT = false;
begin
  result := false;
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
 
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.ValueExists('NukeOnDelete') then
      begin
        // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 
        result := reg.ReadBool('NukeOnDelete');
      end
      else if reg.ValueExists('PurgeInfo') then
      begin
        // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
        // See comment at RecyclerSpecificIsNukeOnDelete()
 
        dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
        result := GetAnsiCharBit(dump[68], 3);
      end
      else
      begin
        // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
 
        result := RES_DEFAULT; // Standardeinstellung bei Windows
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
var
  reg: TRegistry;
  dump: AnsiString;
  d: Byte;
const
  RES_DEFAULT = false;
begin
  result := false;
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
 
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.OpenKeyReadOnly(Drive) then
      begin
        if reg.ValueExists('NukeOnDelete') then
        begin
          // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 
          result := reg.ReadBool('NukeOnDelete');
        end;
        reg.CloseKey;
      end
      else
      begin
        if reg.ValueExists('PurgeInfo') then
        begin
          // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
          dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
 
          // NOT tested, only theoretical! My idea about the possible structure is:
          //
          // Byte      0x40       0x41       0x42       0x43
          // Bit       76543210   76543210   76543210   76543210
          //           --------   --------   --------   --------
          // Meaning   hgfedcba   ponmlkji   xwvutsrq   ????G?zy
          //
          // a..z = Drives
          // G    = global settings
          //
          // Already validated:
          // 0x64 = 04 (00000100)
          // 0x67 = 08 (00001000)
 
          d := _DriveNum(Drive);
          result := GetAnsiCharBit(dump[65+(d div 7)], d mod 7);
        end
        else
        begin
          // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
 
          result := RES_DEFAULT; // Standardeinstellung bei Windows
        end;
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;
begin
  if RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
    result := true
  else if RecyclerHasGlobalSettings then
    result := RecyclerGlobalIsNukeOnDelete
  else
    result := RecyclerSpecificIsNukeOnDelete(Drive);
end;
 
function RecyclerHasGlobalSettings: boolean;
var
  reg: TRegistry;
  dump: string;
begin
  result := false;
 
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
 
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.ValueExists('UseGlobalSettings') then
      begin
        // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 
        result := reg.ReadBool('UseGlobalSettings');
      end
      else if reg.ValueExists('PurgeInfo') then
      begin
        // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
        // TODO: Gibt es ein offizielles Dokument oder ein API, indem PurgeInfo
        // offiziell entschlüsselbar ist?
 
        dump := _registryReadDump(reg, 'PurgeInfo');
        if dump[5] = #$01 then
          result := true
        else if dump[5] = #$00 then
          result := false
        else
          raise EUnknownState.Create(Format(LNG_UNEXPECTED_STATE, ['PurgeInfo']));
      end
      else
      begin
        // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
 
        result := true; // Standardeinstellung bei Windows
      end;
 
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function RecyclerIsEmpty: boolean;
var
  Drive: Char;
begin
  result := true;
  for Drive := 'A' to 'Z' do
  begin
    if RecyclerIsPossible(Drive) and not RecyclerIsEmpty(Drive) then
    begin
      result := false;
      exit;
    end;
  end;
end;
 
function RecyclerIsEmpty(Drive: Char): boolean;
begin
  result := RecyclerGetAPIInfo(Drive).i64NumItems = 0;
end;
 
function RecyclerGetNumItems: int64;
var
  Drive: Char;
begin
  result := 0;
  for Drive := 'A' to 'Z' do
  begin
    if RecyclerIsPossible(Drive) then
    begin
      result := result + RecyclerGetNumItems(Drive);
    end;
  end;
end;
 
function RecyclerGetNumItems(Drive: Char): int64;
begin
  result := RecyclerGetAPIInfo(Drive).i64NumItems;
end;
 
function RecyclerGetSize: int64;
var
  Drive: Char;
begin
  result := 0;
  for Drive := 'A' to 'Z' do
  begin
    if RecyclerIsPossible(Drive) then
    begin
      result := result + RecyclerGetSize(Drive);
    end;
  end;
end;
 
function RecyclerGetSize(Drive: Char): int64;
begin
  result := RecyclerGetAPIInfo(Drive).i64Size;
end;
 
function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo;
begin
  result := RecyclerGetAPIInfo(Drive + ':\');
end;
 
const
  C_SHQueryRecycleBin = 'SHQueryRecycleBinA';
 
type
  TSHQueryRecycleBin = function(pszRootPath: LPCTSTR;
    var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
 
function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo;
var
  PSHQueryRecycleBin: TSHQueryRecycleBin;
  RBHandle: THandle;
  res: HRESULT;
begin
  PSHQueryRecycleBin := nil;
 
  // Ref: http://www.delphipraxis.net/post1291.html
 
  RBHandle := LoadLibrary(shell32);
  if(RBHandle <> 0) then
  begin
    PSHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
    if(@PSHQueryRecycleBin = nil) then
    begin
      FreeLibrary(RBHandle);
      RBHandle := 0;
    end;
  end;
 
  fillchar(result, SizeOf(TSHQueryRBInfo),0);
  result.cbSize := SizeOf(TSHQueryRBInfo);
 
  if (RBHandle <> 0) and (Assigned(PSHQueryRecycleBin)) then
  begin
    res := PSHQueryRecycleBin(PChar(Path), result);
    // if Succeeded(res) then
    if res = S_OK then
    begin
      // Alles OK, unser result hat nun die gewünschten Daten.
    end
    else
    begin
      // Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)
      // if Path is a floppy or CD drive...
      // Windows 10: Error 0x8007003 for Path 'C:\'
      raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);
    end;
  end
  else
    raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);
 
  if (RBHandle <> 0) then FreeLibrary(RBHandle);
end;
 
function RecyclerGetCLSID: string;
begin
  result := RECYCLER_CLSID;
end;
 
// Windows 95 without Internet Explorer 4 has no SHQueryRecycleBinA.
function RecyclerQueryFunctionAvailable: boolean;
var
  RBHandle: THandle;
  SHQueryRecycleBin: TSHQueryRecycleBin;
begin
  RBHandle := LoadLibrary(shell32);
  if(RBHandle <> 0) then
  begin
    SHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
    if(@SHQueryRecycleBin = nil) then
    begin
      FreeLibrary(RBHandle);
      RBHandle := 0;
    end;
  end;
 
  result := RBHandle <> 0;
end;
 
const
  GroupPolicyAcceptHKLMTrick = true;
 
// TODO: In future also detect for other users
// TODO: Also make a setter (inkl. Message to Windows Explorer?)
function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
var
  reg: TRegistry;
begin
  result := gpUndefined;
 
  reg := TRegistry.Create;
  try
    // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
    // even if gpedit.msc shows "Not configured"!
    if GroupPolicyAcceptHKLMTrick then
    begin
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
      begin
        if reg.ValueExists('NoRecycleFiles') then
        begin
          if reg.ReadBool('NoRecycleFiles') then
            result := gpEnabled
          else
            result := gpDisabled;
          Exit;
        end;
        reg.CloseKey;
      end;
    end;
 
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
    begin
      if reg.ValueExists('NoRecycleFiles') then
      begin
        if reg.ReadBool('NoRecycleFiles') then
          result := gpEnabled
        else
          result := gpDisabled;
      end;
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
// TODO: In future also detect for other users
// TODO: Also make a setter (inkl. Message to Windows Explorer?)
function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
var
  reg: TRegistry;
begin
  result := gpUndefined;
  reg := TRegistry.Create;
  try
    // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
    // even if gpedit.msc shows "Not configured"!
    if GroupPolicyAcceptHKLMTrick then
    begin
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
      begin
        if reg.ValueExists('ConfirmFileDelete') then
        begin
          if reg.ReadBool('ConfirmFileDelete') then
            result := gpEnabled
          else
            result := gpDisabled;
          Exit;
        end;
        reg.CloseKey;
      end;
    end;
 
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
    begin
      if reg.ValueExists('ConfirmFileDelete') then
      begin
        if reg.ReadBool('ConfirmFileDelete') then
          result := gpEnabled
        else
          result := gpDisabled;
      end;
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
 
// TODO: In future also detect for other users
// TODO: Also make a setter (inkl. Message to Windows Explorer?)
function RecyclerGroupPolicyRecycleBinSize: integer;
var
  reg: TRegistry;
begin
  result := -1;
  reg := TRegistry.Create;
  try
    // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
    // even if gpedit.msc shows "Not configured"!
    if GroupPolicyAcceptHKLMTrick then
    begin
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
      begin
        if reg.ValueExists('RecycleBinSize') then
        begin
          result := reg.ReadInteger('RecycleBinSize');
          Exit;
        end;
        reg.CloseKey;
      end;
    end;
 
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
    begin
      if reg.ValueExists('RecycleBinSize') then
      begin
        result := reg.ReadInteger('RecycleBinSize');
      end;
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
function GPBoolToString(value: GPOLICYBOOL): String;
begin
  case value of
    gpUndefined: result := 'Not configured';
    gpEnabled: result := 'Enabled';
    gpDisabled: result := 'Disabled';
  end;
end;
 
function RecyclerIsPossible(Drive: Char): boolean;
var
  typ: Integer;
begin
  typ := GetDriveType(PChar(Drive + ':\'));
  result := typ = DRIVE_FIXED;
end;
 
function RecyclerLibraryVersion: string;
begin
  result := 'ViaThinkSoft Recycle Bin Unit [01 JUL 2016]';
end;
 
end.
 

Rev 80	Rev 91
1		1
2	// ********************************************************************************	2	// ********************************************************************************
3	// ** ATTENTION! This unit is not developed anymore. ***	3	// ** ATTENTION! This unit is not developed anymore. ***
4	// ** Please use the new version RecBinUnit2.pas , which is Object-oriented ***	4	// ** Please use the new version RecBinUnit2.pas , which is Object-oriented ***
5	// ********************************************************************************	5	// ********************************************************************************
6		6
7	////////////////////////////////////////////////////////////////////////////////////	7	////////////////////////////////////////////////////////////////////////////////////
8	// RECYCLE-BIN-FUNCTIONS BY DANIEL MARSCHALL //	8	// RECYCLE-BIN-FUNCTIONS BY DANIEL MARSCHALL //
9	// E-MAIL: info@daniel-marschall.de //	9	// E-MAIL: info@daniel-marschall.de //
10	// WEB: www.daniel-marschall.de //	10	// WEB: www.daniel-marschall.de //
11	////////////////////////////////////////////////////////////////////////////////////	11	////////////////////////////////////////////////////////////////////////////////////
12	// Revision: 01 NOV 2016 //	12	// Revision: 01 NOV 2016 //
13	// This unit is freeware, but please link to my website if you are using it! //	13	// This unit is freeware, but please link to my website if you are using it! //
14	////////////////////////////////////////////////////////////////////////////////////	14	////////////////////////////////////////////////////////////////////////////////////
15	// Successfully tested with: //	15	// Successfully tested with: //
16	// Windows 95b (without IE4 Shell Extensions) //	16	// Windows 95b (without IE4 Shell Extensions) //
17	// Windows 95b (with IE4 Shell Extensions) //	17	// Windows 95b (with IE4 Shell Extensions) //
18	// Windows 98-SE //	18	// Windows 98-SE //
19	// Windows NT4 SP6 //	19	// Windows NT4 SP6 //
20	// Windows XP-SP3 //	20	// Windows XP-SP3 //
21	// Windows 2000-SP4 //	21	// Windows 2000-SP4 //
22	// Windows 2003 Server EE SP1 //	22	// Windows 2003 Server EE SP1 //
23	// Windows Vista //	23	// Windows Vista //
24	// Windows 7 //	24	// Windows 7 //
-		25	////////////////////////////////////////////////////////////////////////////////////
-		26	// DOES NOT WORK WITH "VERSION 2" INDEX FILES USED IN LATER VERSIONS OF WIN10 //
25	// Windows 10 //	27	// USE RECYCLE BIN UNIT V2 INSTEAD! //
26	////////////////////////////////////////////////////////////////////////////////////	28	////////////////////////////////////////////////////////////////////////////////////
27	// //	29	// //
28	// Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //	30	// Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //
29	// RecyclerGetDateTime() functions, because the unit "DateUtils" is missing. //	31	// RecyclerGetDateTime() functions, because the unit "DateUtils" is missing. //
30	// Warning! This is a platform unit. //	32	// Warning! This is a platform unit. //
31	// //	33	// //
32	// To do! Can you help? //	34	// To do! Can you help? //
33	// - Win7 : Drive GUIDs //	35	// - Win7 : Drive GUIDs //
34	// - Win7 : Absolute vs. Relative size limitations //	36	// - Win7 : Absolute vs. Relative size limitations //
35	// - WideString-Support (input/output) //	37	// - WideString-Support (input/output) //
36	// - Always do EOF before reading anything? //	38	// - Always do EOF before reading anything? //
37	// - Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext? //	39	// - Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext? //
38	// - RecyclerGetInfofiles() check additionally for removable device? //	40	// - RecyclerGetInfofiles() check additionally for removable device? //
39	// RecyclerIsValid() is false. //	41	// RecyclerIsValid() is false. //
40	// - Make it possible to empty the recycle bin of one specific drive! //	42	// - Make it possible to empty the recycle bin of one specific drive! //
41	// //	43	// //
42	// Unknown! Do you know the answer? //	44	// Unknown! Do you know the answer? //
43	// - How does Windows 9x/NT manage the daylight saving time (if it does)? //	45	// - How does Windows 9x/NT manage the daylight saving time (if it does)? //
44	// - How does Windows Vista react to a RECYCLER\ folder on a NTFS device? //	46	// - How does Windows Vista react to a RECYCLER\ folder on a NTFS device? //
45	// - How does Windows Vista react to a RECYCLED\ folder on a FAT device? //	47	// - How does Windows Vista react to a RECYCLED\ folder on a FAT device? //
46	// //	48	// //
47	// Thanks to all these who have helped me solving coding problems. //	49	// Thanks to all these who have helped me solving coding problems. //
48	// Thanks to SEBA for sending in the Windows Vista trash structure files. //	50	// Thanks to SEBA for sending in the Windows Vista trash structure files. //
49	// Thanks to OMATA for testing the unit with Delphi 4. //	51	// Thanks to OMATA for testing the unit with Delphi 4. //
50	// Thanks to DEITYSOU for making a bugfix of DriveExists() //	52	// Thanks to DEITYSOU for making a bugfix of DriveExists() //
51	// //	53	// //
52	////////////////////////////////////////////////////////////////////////////////////	54	////////////////////////////////////////////////////////////////////////////////////
53		55
54	(*	56	(*
55		57
56	== TODO LISTE ==	58	== TODO LISTE ==
57		59
58	- Wichtig! Windows XP: InfoTip, IntroText und LocalizedString sind Resourcenangaben und müssen ausgelesen werden!	60	- Wichtig! Windows XP: InfoTip, IntroText und LocalizedString sind Resourcenangaben und müssen ausgelesen werden!
59	- Testen: Wie reagiert Windows, wenn Bitbucket\C existiert, aber kein Wert 'Percent' hat? Mit der Standardeinstellung?	61	- Testen: Wie reagiert Windows, wenn Bitbucket\C existiert, aber kein Wert 'Percent' hat? Mit der Standardeinstellung?
60	- Bug: Windows 2000 bei bestehenden Windows 95 Partition: Recycler Filename ist dann Recycled und nicht Recycler!	62	- Bug: Windows 2000 bei bestehenden Windows 95 Partition: Recycler Filename ist dann Recycled und nicht Recycler!
61	- bug? w95 recycled file hat immer selben löschzeitpunkt und größe? war die nicht verschieden?	63	- bug? w95 recycled file hat immer selben löschzeitpunkt und größe? war die nicht verschieden?
62	- beachtet? bei leerem papierkorb auf fat ist weder info noch info2 vorhanden?	64	- beachtet? bei leerem papierkorb auf fat ist weder info noch info2 vorhanden?
63	- testen: auch möglich, einen vista papierkorb offline öffnen?	65	- testen: auch möglich, einen vista papierkorb offline öffnen?
64	- Problem: bei win95(ohne ie4) und win2000 gleichzeitiger installation: es existiert info UND info2!!!	66	- Problem: bei win95(ohne ie4) und win2000 gleichzeitiger installation: es existiert info UND info2!!!
65	- Implement SETTER functions to every kind of configuration thing. (percentage etc)	67	- Implement SETTER functions to every kind of configuration thing. (percentage etc)
66	- Registry CURRENT_USER: Funktionen auch für fremde Benutzer zur Verfügung stellen?	68	- Registry CURRENT_USER: Funktionen auch für fremde Benutzer zur Verfügung stellen?
67	- Es sollte möglich sein, dass ein Laufwerk mehr als 1 Recycler beinhaltet -- behandeln	69	- Es sollte möglich sein, dass ein Laufwerk mehr als 1 Recycler beinhaltet -- behandeln
68		70
69	=== Future Ideas ===	71	=== Future Ideas ===
70		72
71	- Demoapplikation: Dateien statt Text als Explorer-Like (TListView)?	73	- Demoapplikation: Dateien statt Text als Explorer-Like (TListView)?
72	- Einzelne Elemente oder alle wiederherstellen oder löschen	74	- Einzelne Elemente oder alle wiederherstellen oder löschen
73	- Konfiguration für Laufwerke ändern etc	75	- Konfiguration für Laufwerke ändern etc
74	- IconString -> TIcon Convertion functions	76	- IconString -> TIcon Convertion functions
75	- platzreservierung in mb-angabe berechnen	77	- platzreservierung in mb-angabe berechnen
76	- I don't know if there exists any API function which checks the state at any internal way.	78	- I don't know if there exists any API function which checks the state at any internal way.
77	- copy/move files from recyclebin	79	- copy/move files from recyclebin
78		80
79	*)	81	*)
80		82
81	// TODO: Also include BC++ Versions	83	// TODO: Also include BC++ Versions
82	{$IFNDEF BCB}	84	{$IFNDEF BCB}
83	{$DEFINE DEL1UP}	85	{$DEFINE DEL1UP}
84	{$IFNDEF VER80}	86	{$IFNDEF VER80}
85	{$DEFINE DEL2UP}	87	{$DEFINE DEL2UP}
86	{$IFNDEF VER90}	88	{$IFNDEF VER90}
87	{$DEFINE DEL3UP}	89	{$DEFINE DEL3UP}
88	{$IFNDEF VER100}	90	{$IFNDEF VER100}
89	{$DEFINE DEL4UP}	91	{$DEFINE DEL4UP}
90	{$IFNDEF VER120}	92	{$IFNDEF VER120}
91	{$DEFINE DEL5UP}	93	{$DEFINE DEL5UP}
92	{$IFNDEF VER130}	94	{$IFNDEF VER130}
93	{$DEFINE DEL6UP}	95	{$DEFINE DEL6UP}
94	{$IFNDEF VER140}	96	{$IFNDEF VER140}
95	{$DEFINE DEL7UP}	97	{$DEFINE DEL7UP}
96	{$ENDIF}	98	{$ENDIF}
97	{$ENDIF}	99	{$ENDIF}
98	{$ENDIF}	100	{$ENDIF}
99	{$ENDIF}	101	{$ENDIF}
100	{$ENDIF}	102	{$ENDIF}
101	{$ENDIF}	103	{$ENDIF}
102	{$ENDIF}	104	{$ENDIF}
103		105
104	{$IFDEF DEL7UP}	106	{$IFDEF DEL7UP}
105	{$WARN UNSAFE_TYPE OFF}	107	{$WARN UNSAFE_TYPE OFF}
106	{$WARN UNSAFE_CODE OFF}	108	{$WARN UNSAFE_CODE OFF}
107	{$WARN UNSAFE_CAST OFF}	109	{$WARN UNSAFE_CAST OFF}
108	{$ENDIF}	110	{$ENDIF}
109		111
110	{$IFDEF DEL6UP}	112	{$IFDEF DEL6UP}
111	unit RecyclerFunctions platform;	113	unit RecyclerFunctions platform;
112	{$ELSE}	114	{$ELSE}
113	unit RecyclerFunctions;	115	unit RecyclerFunctions;
114	{$ENDIF}	116	{$ENDIF}
115		117
116	// Configuration	118	// Configuration
117		119
118	// If enabled, all functions with parameter "InfofileOrRecycleFolder" will	120	// If enabled, all functions with parameter "InfofileOrRecycleFolder" will
119	// also accept files which are not the indexfile (then, a INFO2 or INFO file	121	// also accept files which are not the indexfile (then, a INFO2 or INFO file
120	// will be searched in this directory).	122	// will be searched in this directory).
121	{.$DEFINE allow_all_filenames}	123	{.$DEFINE allow_all_filenames}
122		124
123	interface	125	interface
124		126
125	uses	127	uses
126	Windows, SysUtils, Classes, {$IFDEF DEL6UP}DateUtils,{$ENDIF}	128	Windows, SysUtils, Classes, {$IFDEF DEL6UP}DateUtils,{$ENDIF}
127	ShellApi{$IFNDEF DEL6UP}, FileCtrl{$ENDIF}, Registry,	129	ShellApi{$IFNDEF DEL6UP}, FileCtrl{$ENDIF}, Registry,
128	Messages, BitOps;	130	Messages, BitOps;
129		131
130	type	132	type
131	EUnknownState = class(Exception);	133	EUnknownState = class(Exception);
132	EEventCategoryNotDefined = class(Exception);	134	EEventCategoryNotDefined = class(Exception);
133	EAPICallError = class(Exception);	135	EAPICallError = class(Exception);
134		136
135	PSHQueryRBInfo = ^TSHQueryRBInfo;	137	PSHQueryRBInfo = ^TSHQueryRBInfo;
136	TSHQueryRBInfo = packed record	138	TSHQueryRBInfo = packed record
137	cbSize : dword;	139	cbSize : dword;
138	i64Size : int64;	140	i64Size : int64;
139	i64NumItems : int64;	141	i64NumItems : int64;
140	end;	142	end;
141		143
142	GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);	144	GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
143		145
144	const	146	const
145	RECYCLER_CLSID = '{645FF040-5081-101B-9F08-00AA002F954E}';	147	RECYCLER_CLSID = '{645FF040-5081-101B-9F08-00AA002F954E}';
146		148
147	{$IFDEF DEL6UP}	149	{$IFDEF DEL6UP}
148	function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;	150	function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
149	function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;	151	function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
150	function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;	152	function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
151	function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;	153	function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
152	{$ENDIF}	154	{$ENDIF}
153		155
154	function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;	156	function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
155	function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;	157	function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
156	function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;	158	function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
157	function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;	159	function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
158		160
159	function RecyclerGetSource(drive: char; fileid: string): string; overload;	161	function RecyclerGetSource(drive: char; fileid: string): string; overload;
160	function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;	162	function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
161	function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;	163	function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
162	function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;	164	function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
163		165
164	procedure RecyclerListIndexes(drive: char; result: TStringList); overload;	166	procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
165	procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;	167	procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
166	procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;	168	procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
167		169
168	function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;	170	function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
169	function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;	171	function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
170	function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;	172	function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
171	function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;	173	function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
172		174
173	function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;	175	function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
174	function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;	176	function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
175	function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;	177	function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
176	function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;	178	function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
177		179
178	function RecyclerIsValid(drive: char): boolean; overload;	180	function RecyclerIsValid(drive: char): boolean; overload;
179	function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;	181	function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
180	function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;	182	function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
181		183
182	function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;	184	function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
183	function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;	185	function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
184	function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;	186	function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
185	function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;	187	function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
186		188
187	function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;	189	function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
188	function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;	190	function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
189	function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;	191	function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
190	function RecyclerGetPath(drive: char; UserSID: string): string; overload;	192	function RecyclerGetPath(drive: char; UserSID: string): string; overload;
191	function RecyclerGetPath(drive: char): string; overload;	193	function RecyclerGetPath(drive: char): string; overload;
192		194
193	procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;	195	procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
194	procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;	196	procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
195	procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;	197	procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
196	procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;	198	procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
197	procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;	199	procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
198		200
199	function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;	201	function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
200	function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;	202	function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
201	function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;	203	function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
202		204
203	function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;	205	function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
204	function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;	206	function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
205	function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;	207	function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
206		208
207	procedure RecyclerGetAllRecyclerDrives(result: TStringList);	209	procedure RecyclerGetAllRecyclerDrives(result: TStringList);
208		210
209	function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;	211	function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
210	function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;	212	function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
211		213
212	function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;	214	function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
213	function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;	215	function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
214		216
215	function RecyclerConfirmationDialogEnabled: boolean;	217	function RecyclerConfirmationDialogEnabled: boolean;
216	function RecyclerShellStateConfirmationDialogEnabled: boolean;	218	function RecyclerShellStateConfirmationDialogEnabled: boolean;
217	procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);	219	procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
218		220
219	function RecyclerGetCurrentIconString: string;	221	function RecyclerGetCurrentIconString: string;
220	function RecyclerGetDefaultIconString: string;	222	function RecyclerGetDefaultIconString: string;
221	function RecyclerGetEmptyIconString: string;	223	function RecyclerGetEmptyIconString: string;
222	function RecyclerGetFullIconString: string;	224	function RecyclerGetFullIconString: string;
223		225
224	function RecyclerGetName: string;	226	function RecyclerGetName: string;
225	function RecyclerGetInfoTip: string;	227	function RecyclerGetInfoTip: string;
226	function RecyclerGetIntroText: string;	228	function RecyclerGetIntroText: string;
227		229
228	function RecyclerEmptyEventGetName: string;	230	function RecyclerEmptyEventGetName: string;
229	function RecyclerEmptyEventGetCurrentSound: string;	231	function RecyclerEmptyEventGetCurrentSound: string;
230	function RecyclerEmptyEventGetDefaultSound: string;	232	function RecyclerEmptyEventGetDefaultSound: string;
231	procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);	233	procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
232	function RecyclerEmptyEventGetSound(ACategory: string): string;	234	function RecyclerEmptyEventGetSound(ACategory: string): string;
233		235
234	function RecyclerGlobalGetPercentUsage: integer;	236	function RecyclerGlobalGetPercentUsage: integer;
235	function RecyclerSpecificGetPercentUsage(Drive: Char): integer;	237	function RecyclerSpecificGetPercentUsage(Drive: Char): integer;
236	function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;	238	function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;
237		239
238	function RecyclerGlobalIsNukeOnDelete: boolean;	240	function RecyclerGlobalIsNukeOnDelete: boolean;
239	function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;	241	function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
240	function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;	242	function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;
241		243
242	function RecyclerHasGlobalSettings: boolean;	244	function RecyclerHasGlobalSettings: boolean;
243		245
244	function RecyclerIsEmpty: boolean; overload;	246	function RecyclerIsEmpty: boolean; overload;
245	function RecyclerIsEmpty(Drive: Char): boolean; overload;	247	function RecyclerIsEmpty(Drive: Char): boolean; overload;
246		248
247	function RecyclerGetNumItems: int64; overload;	249	function RecyclerGetNumItems: int64; overload;
248	function RecyclerGetNumItems(Drive: Char): int64; overload;	250	function RecyclerGetNumItems(Drive: Char): int64; overload;
249		251
250	function RecyclerGetSize: int64; overload;	252	function RecyclerGetSize: int64; overload;
251	function RecyclerGetSize(Drive: Char): int64; overload;	253	function RecyclerGetSize(Drive: Char): int64; overload;
252		254
253	function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo; overload;	255	function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo; overload;
254	function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo; overload;	256	function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo; overload;
255		257
256	function RecyclerGetCLSID: string;	258	function RecyclerGetCLSID: string;
257		259
258	// Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer	260	// Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer
259	// 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben	261	// 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben
260	// werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da	262	// werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da
261	// unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:	263	// unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:
262	// - RecyclerIsEmpty	264	// - RecyclerIsEmpty
263	// - RecyclerGetNumItems	265	// - RecyclerGetNumItems
264	// - RecyclerGetSize	266	// - RecyclerGetSize
265	// - RecyclerGetAPIInfo	267	// - RecyclerGetAPIInfo
266	function RecyclerQueryFunctionAvailable: boolean;	268	function RecyclerQueryFunctionAvailable: boolean;
267		269
268	function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;	270	function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
269	function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;	271	function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
270	function RecyclerGroupPolicyRecycleBinSize: integer;	272	function RecyclerGroupPolicyRecycleBinSize: integer;
271		273
272	function GPBoolToString(value: GPOLICYBOOL): String;	274	function GPBoolToString(value: GPOLICYBOOL): String;
273		275
274	function RecyclerIsPossible(Drive: Char): boolean;	276	function RecyclerIsPossible(Drive: Char): boolean;
275		277
276	function RecyclerLibraryVersion: string;	278	function RecyclerLibraryVersion: string;
277		279
278	implementation	280	implementation
279		281
280	type	282	type
281	SHELLSTATE = record	283	SHELLSTATE = record
282	Flags1: DWORD;	284	Flags1: DWORD;
283	(*	285	(*
284	BOOL fShowAllObjects : 1;	286	BOOL fShowAllObjects : 1;
285	BOOL fShowExtensions : 1;	287	BOOL fShowExtensions : 1;
286	BOOL fNoConfirmRecycle : 1;	288	BOOL fNoConfirmRecycle : 1;
287		289
288	BOOL fShowSysFiles : 1;	290	BOOL fShowSysFiles : 1;
289	BOOL fShowCompColor : 1;	291	BOOL fShowCompColor : 1;
290	BOOL fDoubleClickInWebView : 1;	292	BOOL fDoubleClickInWebView : 1;
291	BOOL fDesktopHTML : 1;	293	BOOL fDesktopHTML : 1;
292	BOOL fWin95Classic : 1;	294	BOOL fWin95Classic : 1;
293	BOOL fDontPrettyPath : 1;	295	BOOL fDontPrettyPath : 1;
294	BOOL fShowAttribCol : 1; // No longer used, dead bit	296	BOOL fShowAttribCol : 1; // No longer used, dead bit
295	BOOL fMapNetDrvBtn : 1;	297	BOOL fMapNetDrvBtn : 1;
296	BOOL fShowInfoTip : 1;	298	BOOL fShowInfoTip : 1;
297	BOOL fHideIcons : 1;	299	BOOL fHideIcons : 1;
298	BOOL fWebView : 1;	300	BOOL fWebView : 1;
299	BOOL fFilter : 1;	301	BOOL fFilter : 1;
300	BOOL fShowSuperHidden : 1;	302	BOOL fShowSuperHidden : 1;
301	BOOL fNoNetCrawling : 1;	303	BOOL fNoNetCrawling : 1;
302	*)	304	*)
303	dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts	305	dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts
304	uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts	306	uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts
305		307
306	// Note: Not a typo! This is a persisted structure so we cannot use LPARAM	308	// Note: Not a typo! This is a persisted structure so we cannot use LPARAM
307	lParamSort: Integer;	309	lParamSort: Integer;
308	iSortDirection: Integer;	310	iSortDirection: Integer;
309		311
310	version: UINT;	312	version: UINT;
311		313
312	// new for win2k. need notUsed var to calc the right size of ie4 struct	314	// new for win2k. need notUsed var to calc the right size of ie4 struct
313	// FIELD_OFFSET does not work on bit fields	315	// FIELD_OFFSET does not work on bit fields
314	uNotUsed: UINT; // feel free to rename and use	316	uNotUsed: UINT; // feel free to rename and use
315	Flags2: DWORD;	317	Flags2: DWORD;
316	(*	318	(*
317	BOOL fSepProcess: 1;	319	BOOL fSepProcess: 1;
318	// new for Whistler.	320	// new for Whistler.
319	BOOL fStartPanelOn: 1; //Indicates if the Whistler StartPanel mode is ON or OFF.	321	BOOL fStartPanelOn: 1; //Indicates if the Whistler StartPanel mode is ON or OFF.
320	BOOL fShowStartPage: 1; //Indicates if the Whistler StartPage on desktop is ON or OFF.	322	BOOL fShowStartPage: 1; //Indicates if the Whistler StartPage on desktop is ON or OFF.
321	UINT fSpareFlags : 13;	323	UINT fSpareFlags : 13;
322	*)	324	*)
323	end;	325	end;
324	LPSHELLSTATE = ^SHELLSTATE;	326	LPSHELLSTATE = ^SHELLSTATE;
325		327
326	const	328	const
327	{$IFDEF MSWINDOWS}	329	{$IFDEF MSWINDOWS}
328	shell32 = 'shell32.dll';	330	shell32 = 'shell32.dll';
329	advapi32 = 'advapi32.dll';	331	advapi32 = 'advapi32.dll';
330	{$ENDIF}	332	{$ENDIF}
331	{$IFDEF LINUX}	333	{$IFDEF LINUX}
332	shell32 = 'libshell32.borland.so';	334	shell32 = 'libshell32.borland.so';
333	advapi32 = 'libwine.borland.so';	335	advapi32 = 'libwine.borland.so';
334	{$ENDIF}	336	{$ENDIF}
335		337
336	// Masks for the shellstate	338	// Masks for the shellstate
337	SSF_SHOWALLOBJECTS = $00000001;	339	SSF_SHOWALLOBJECTS = $00000001;
338	SSF_SHOWEXTENSIONS = $00000002;	340	SSF_SHOWEXTENSIONS = $00000002;
339	SSF_HIDDENFILEEXTS = $00000004;	341	SSF_HIDDENFILEEXTS = $00000004;
340	SSF_SERVERADMINUI = $00000004;	342	SSF_SERVERADMINUI = $00000004;
341	SSF_SHOWCOMPCOLOR = $00000008;	343	SSF_SHOWCOMPCOLOR = $00000008;
342	SSF_SORTCOLUMNS = $00000010;	344	SSF_SORTCOLUMNS = $00000010;
343	SSF_SHOWSYSFILES = $00000020;	345	SSF_SHOWSYSFILES = $00000020;
344	SSF_DOUBLECLICKINWEBVIEW = $00000080;	346	SSF_DOUBLECLICKINWEBVIEW = $00000080;
345	SSF_SHOWATTRIBCOL = $00000100;	347	SSF_SHOWATTRIBCOL = $00000100;
346	SSF_DESKTOPHTML = $00000200;	348	SSF_DESKTOPHTML = $00000200;
347	SSF_WIN95CLASSIC = $00000400;	349	SSF_WIN95CLASSIC = $00000400;
348	SSF_DONTPRETTYPATH = $00000800;	350	SSF_DONTPRETTYPATH = $00000800;
349	SSF_SHOWINFOTIP = $00002000;	351	SSF_SHOWINFOTIP = $00002000;
350	SSF_MAPNETDRVBUTTON = $00001000;	352	SSF_MAPNETDRVBUTTON = $00001000;
351	SSF_NOCONFIRMRECYCLE = $00008000;	353	SSF_NOCONFIRMRECYCLE = $00008000;
352	SSF_HIDEICONS = $00004000;	354	SSF_HIDEICONS = $00004000;
353	SSF_FILTER = $00010000;	355	SSF_FILTER = $00010000;
354	SSF_WEBVIEW = $00020000;	356	SSF_WEBVIEW = $00020000;
355	SSF_SHOWSUPERHIDDEN = $00040000;	357	SSF_SHOWSUPERHIDDEN = $00040000;
356	SSF_SEPPROCESS = $00080000;	358	SSF_SEPPROCESS = $00080000;
357	SSF_NONETCRAWLING = $00100000;	359	SSF_NONETCRAWLING = $00100000;
358	SSF_STARTPANELON = $00200000;	360	SSF_STARTPANELON = $00200000;
359	SSF_SHOWSTARTPAGE = $00400000;	361	SSF_SHOWSTARTPAGE = $00400000;
360		362
361	// **********************************************************	363	// **********************************************************
362	// COMPATIBILITY FUNCTIONS	364	// COMPATIBILITY FUNCTIONS
363	// **********************************************************	365	// **********************************************************
364		366
365	{$IFNDEF DEL5UP}	367	{$IFNDEF DEL5UP}
366	function IncludeTrailingBackslash(str: string): string;	368	function IncludeTrailingBackslash(str: string): string;
367	begin	369	begin
368	if Copy(str, length(str), 1) = '\' then // TODO? Gibt es PathDelim in Delphi 4?	370	if Copy(str, length(str), 1) = '\' then // TODO? Gibt es PathDelim in Delphi 4?
369	Result := str	371	Result := str
370	else	372	else
371	Result := str + '\';	373	Result := str + '\';
372	end;	374	end;
373	{$ENDIF}	375	{$ENDIF}
374		376
375	// **********************************************************	377	// **********************************************************
376	// INTERNALLY USED FUNCTIONS	378	// INTERNALLY USED FUNCTIONS
377	// **********************************************************	379	// **********************************************************
378		380
379	resourcestring	381	resourcestring
380	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!';	382	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!';
381	LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';	383	LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';
382	LNG_NOT_CALLABLE = '%s not callable';	384	LNG_NOT_CALLABLE = '%s not callable';
383	LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s';	385	LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s';
384		386
385	function _DeleteDirectory(const Name: string): boolean;	387	function _DeleteDirectory(const Name: string): boolean;
386	var	388	var
387	F: TSearchRec;	389	F: TSearchRec;
388	begin	390	begin
389	result := true;	391	result := true;
390	if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then	392	if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then
391	begin	393	begin
392	try	394	try
393	repeat	395	repeat
394	if (F.Attr and faDirectory <> 0) then	396	if (F.Attr and faDirectory <> 0) then
395	begin	397	begin
396	if (F.Name <> '.') and (F.Name <> '..') then	398	if (F.Name <> '.') and (F.Name <> '..') then
397	begin	399	begin
398	result := result and _DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);	400	result := result and _DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);
399	end;	401	end;
400	end	402	end
401	else	403	else
402	begin	404	begin
403	if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;	405	if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;
404	end;	406	end;
405	until FindNext(F) <> 0;	407	until FindNext(F) <> 0;
406	finally	408	finally
407	FindClose(F);	409	FindClose(F);
408	end;	410	end;
409	if not RemoveDir(Name) then result := false;	411	if not RemoveDir(Name) then result := false;
410	end;	412	end;
411	end;	413	end;
412		414
413	function _FileSize(FileName: string): int64;	415	function _FileSize(FileName: string): int64;
414	var	416	var
415	fs: TFileStream;	417	fs: TFileStream;
416	begin	418	begin
417	fs := TFileStream.Create(FileName, fmOpenRead);	419	fs := TFileStream.Create(FileName, fmOpenRead);
418	try	420	try
419	result := fs.size;	421	result := fs.size;
420	finally	422	finally
421	fs.free;	423	fs.free;
422	end;	424	end;
423	end;	425	end;
424		426
425	function _DriveNum(Drive: Char): Byte;	427	function _DriveNum(Drive: Char): Byte;
426	// a->0, ..., z->25	428	// a->0, ..., z->25
427	var	429	var
428	tmp: string;	430	tmp: string;
429	begin	431	begin
430	tmp := LowerCase(Drive);	432	tmp := LowerCase(Drive);
431	result := Ord(tmp[1])-Ord('a');	433	result := Ord(tmp[1])-Ord('a');
432	end;	434	end;
433		435
434	function _registryReadDump(AReg: TRegistry; AName: string): string;	436	function _registryReadDump(AReg: TRegistry; AName: string): string;
435	const	437	const
436	// Win2000 RegEdit has set the max input length of a REG_BINARY to $3FFF.	438	// Win2000 RegEdit has set the max input length of a REG_BINARY to $3FFF.
437	// Probably its the longest possible binary string and not just a GUI limit.	439	// Probably its the longest possible binary string and not just a GUI limit.
438	BufMax = $3FFF;	440	BufMax = $3FFF;
439	var	441	var
440	buf: array[0..BufMax] of byte;	442	buf: array[0..BufMax] of byte;
441	i: integer;	443	i: integer;
442	realsize: integer;	444	realsize: integer;
443	begin	445	begin
444	realsize := AReg.ReadBinaryData(AName, buf, SizeOf(buf));	446	realsize := AReg.ReadBinaryData(AName, buf, SizeOf(buf));
445		447
446	for i := 0 to realsize-1 do	448	for i := 0 to realsize-1 do
447	begin	449	begin
448	result := result + chr(buf[i]);	450	result := result + chr(buf[i]);
449	end;	451	end;
450	end;	452	end;
451		453
452	function _GetStringFromDLL(filename: string; num: integer): string;	454	function _GetStringFromDLL(filename: string; num: integer): string;
453	const	455	const
454	// http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp	456	// http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp
455	MAX_BUF = 4097; // OK?	457	MAX_BUF = 4097; // OK?
456	var	458	var
457	hLib: THandle;	459	hLib: THandle;
458	buf: array[0..MAX_BUF] of char;	460	buf: array[0..MAX_BUF] of char;
459	begin	461	begin
460	hLib := LoadLibrary(PChar(filename));	462	hLib := LoadLibrary(PChar(filename));
461	try	463	try
462	LoadString(hLib, num, buf, sizeof(buf));	464	LoadString(hLib, num, buf, sizeof(buf));
463	result := buf;	465	result := buf;
464	finally	466	finally
465	FreeLibrary(hLib);	467	FreeLibrary(hLib);
466	end;	468	end;
467	end;	469	end;
468		470
469	// http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html	471	// http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html
470	function _ExpandEnvStr(const szInput: string): string;	472	function _ExpandEnvStr(const szInput: string): string;
471	const	473	const
472	MAXSIZE = 32768; // laut PSDK sind 32k das Maximum	474	MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
473	begin	475	begin
474	SetLength(Result,MAXSIZE);	476	SetLength(Result,MAXSIZE);
475	SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),	477	SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
476	@Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen	478	@Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
477	end;	479	end;
478		480
479	// Beispiele	481	// Beispiele
480	// Papierkorb -- Windows 95	482	// Papierkorb -- Windows 95
481	// @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb -- Windows 2000	483	// @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb -- Windows 2000
482		484
483	function _DecodeReferenceString(s: string): string;	485	function _DecodeReferenceString(s: string): string;
484	var	486	var
485	dll, id, lang, cache: string;	487	dll, id, lang, cache: string;
486	sl, sl2: tstringlist;	488	sl, sl2: tstringlist;
487	begin	489	begin
488	if Copy(s, 1, 1) = '@' then	490	if Copy(s, 1, 1) = '@' then
489	begin	491	begin
490	// Referenz auf eine DLL	492	// Referenz auf eine DLL
491	// @<dll>,-<id>[@<lang>][,<cache>]	493	// @<dll>,-<id>[@<lang>][,<cache>]
492		494
493	sl := TStringList.Create;	495	sl := TStringList.Create;
494	try	496	try
495	// '@' am Anfang entfernen	497	// '@' am Anfang entfernen
496	s := Copy(s, 2, length(s)-1);	498	s := Copy(s, 2, length(s)-1);
497		499
498	// Nach ',' auftrennen	500	// Nach ',' auftrennen

Subversion Repositories recyclebinunit

recyclebinunit/trunk/Recycle Bin Unit/RecyclerFunctions.pas – Rev 80 → 91