Subversion Repositories recyclebinunit

Rev

Rev 100 | Rev 102 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit RecBinUnit2 platform;
  2.  
  3. ////////////////////////////////////////////////////////////////////////////////////
  4. // RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT                          //
  5. // E-MAIL: info@daniel-marschall.de                                               //
  6. // Web:    www.daniel-marschall.de & www.viathinksoft.de                          //
  7. ////////////////////////////////////////////////////////////////////////////////////
  8. // Revision: 03 JUL 2022                                                          //
  9. // This unit is freeware, but please link to my website if you are using it!      //
  10. ////////////////////////////////////////////////////////////////////////////////////
  11. // Successfully tested with:                                                      //
  12. // Windows 95b (without IE4 Shell Extensions)                                     //
  13. // Windows 95b (with IE4 Shell Extensions)                                        //
  14. // Windows 98 SE                                                                  //
  15. // Windows NT4 SP6                                                                //
  16. // Windows XP SP3                                                                 //
  17. // Windows 2000 SP4                                                               //
  18. // Windows 2003 Server EE SP1                                                     //
  19. // Windows Vista                                                                  //
  20. // Windows 7                                                                      //
  21. // Windows 10 (version 1 and version 2 format)                                    //
  22. // Windows 11                                                                     //
  23. ////////////////////////////////////////////////////////////////////////////////////
  24.  
  25. // Delphi 7 Compatibility:  (TODO: compiler switches)
  26. // - Remove "static"
  27. // - Remove "strict"
  28. // - Remove "$REGION"
  29.  
  30. // TODO: ReadBuffer überall try-except
  31. // TODO: Always check EOF before reading anything?
  32. // TODO: Don't crash when timestamp is invalid. Do something else instead.
  33. // TODO: Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext?
  34. // TODO: RecyclerGetInfofiles() check additionally for removable device?
  35. //       RecyclerIsValid() is false.
  36. // TODO: Make it possible to empty the recycle bin of one specific drive!
  37. // TODO: Unknown! Do you know the answer?
  38. //       - How does Windows 9x/NT manage the daylight saving time (if it does)?
  39. //       - How does Windows Vista+ react to a RECYCLER\ folder on a NTFS device?
  40. //       - How does Windows Vista+ react to a RECYCLED\ folder on a FAT device? ==> Win7: is ignored!
  41. //       - How does Windows XP react to RECYCLED\ folder on a FAT device?
  42. // TODO: Translate all comments from German to English
  43. // TODO: Do we need this (maybe not all drives have A: till Z:?) http://stackoverflow.com/questions/17110543/how-to-retrieve-the-disk-signature-of-all-the-disks-in-windows-using-delphi-7
  44. // TODO: Add a lot of setters for system config stuff
  45.  
  46. // If enabled, the deletion timestamps will not be converted by the WinAPI.
  47. {.$DEFINE FILETIME_DELPHI_CODE}
  48.  
  49. // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, even if gpedit.msc shows "Not configured"!
  50. {$DEFINE GroupPolicyAcceptHKLMTrick}
  51.  
  52. interface
  53.  
  54. uses
  55.   Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;
  56.  
  57. const
  58.   RECBINUNIT_VERSION = '2022-07-03';
  59.  
  60.   RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';
  61.   NULL_GUID:      TGUID = '{00000000-0000-0000-0000-000000000000}';
  62.  
  63. type
  64.   EAPICallError = class(Exception);
  65.   EEventCategoryNotDefined = class(Exception);
  66.   EInvalidDrive = class(Exception);
  67.  
  68.   PSHQueryRBInfo = ^TSHQueryRBInfo;
  69.   {$IFDEF WIN64}
  70.   // ATTENTION! MUST NOT BE PACKED! Alignment for 64 bit must be 8 and for 32 bit must be 4
  71.   TSHQueryRBInfo = record
  72.   {$ELSE}
  73.   TSHQueryRBInfo = packed record
  74.   {$ENDIF}
  75.     cbSize      : DWORD;
  76.     i64Size     : int64;
  77.     i64NumItems : int64;
  78.   end;
  79.  
  80.   TRbRecycleBinItem = class(TObject)
  81.   strict private
  82.     function GetSource: string;
  83.   strict protected
  84.     FSourceAnsi: AnsiString;
  85.     FSourceUnicode: WideString;
  86.     FID: string;
  87.     FSourceDrive: Char;
  88.     FDeletionTime: TDateTime;
  89.     FOriginalSize: int64;
  90.     FIndexFile: string;
  91.     FRemovedEntry: boolean;
  92.     procedure ReadFromStream(stream: TStream); virtual; abstract;
  93.     function GetPhysicalFile: string; virtual; abstract; // protected, because it will be read by "property"
  94.   public
  95.     property PhysicalFile: string read GetPhysicalFile;
  96.     property SourceAnsi: AnsiString read FSourceAnsi;
  97.     property SourceUnicode: WideString read FSourceUnicode;
  98.     property Source: string read GetSource; // will bei either ANSI or Unicode, depending on the Delphi version
  99.     property ID: string read FID;
  100.     property SourceDrive: Char read FSourceDrive;
  101.     property DeletionTime: TDateTime read FDeletionTime;
  102.     property OriginalSize: int64 read FOriginalSize;
  103.     property IndexFile: string read FIndexFile;
  104.     property RemovedEntry: boolean read FRemovedEntry; // the file is NOT in the recycle bin anymore!
  105.  
  106.     // Attention: There are no official API calls. The delete and recover
  107.     // functions might fail and/or damage the shell cache. Handle with care!
  108.     function DeleteFile: boolean; virtual; abstract;
  109.     function RecoverFile: boolean; virtual; abstract;
  110.     function OpenFile: boolean; virtual; abstract;
  111.   end;
  112.  
  113.   TRbInfoAItem = class(TRbRecycleBinItem)
  114.   strict protected
  115.     procedure ReadFromStream(stream: TStream); override;
  116.     function GetPhysicalFile: string; override;
  117.   public
  118.     constructor Create(fs: TStream; AIndexFile: string);
  119.     function DeleteFile: boolean; override;
  120.     // TODO: function RecoverFile: boolean; override;
  121.     // TODO: function OpenFile: boolean; override;
  122.   end;
  123.  
  124.   TRbInfoWItem = class(TRbRecycleBinItem)
  125.   strict protected
  126.     procedure ReadFromStream(stream: TStream); override;
  127.     function GetPhysicalFile: string; override;
  128.   public
  129.     constructor Create(fs: TStream; AIndexFile: string);
  130.     function DeleteFile: boolean; override;
  131.     // TODO: function RecoverFile: boolean; override;
  132.     // TODO: function OpenFile: boolean; override;
  133.   end;
  134.  
  135.   TRbVistaItem = class(TRbRecycleBinItem)
  136.   strict protected
  137.     procedure ReadFromStream(stream: TStream); override;
  138.     function GetPhysicalFile: string; override;
  139.   public
  140.     constructor Create(fs: TStream; AIndexFile, AID: string);
  141.     function DeleteFile: boolean; override;
  142.     // TODO: function RecoverFile: boolean; override;
  143.     // TODO: function OpenFile: boolean; override;
  144.   end;
  145.  
  146.   TRbRecycleBin = class(TObject)
  147.   strict private
  148.     FFileOrDirectory: string;
  149.     FSID: string;
  150.     FTolerantReading: boolean;
  151.   public
  152.     constructor Create(AFileOrDirectory: string; ASID: string='');
  153.  
  154.     function GetItem(id: string): TRbRecycleBinItem;
  155.     procedure ListItems(list: TObjectList{TRbRecycleBinItem});
  156.     function CheckIndexes(slErrors: TStrings): boolean;
  157.  
  158.     property FileOrDirectory: string read FFileOrDirectory;
  159.     property SID: string read FSID;
  160.  
  161.     // Allows an index file to be read, even if an incompatible multiboot combination
  162.     // corrupted it. Default: true.
  163.     property TolerantReading: boolean read FTolerantReading write FTolerantReading;
  164.   end;
  165.  
  166.   // TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind?
  167.   TRbDrive = class(TObject)
  168.   strict private
  169.     FDriveLetter: AnsiChar;
  170.  
  171.     function OldCapacityPercent(var res: integer): boolean; // in % (0-100)
  172.     function NewCapacityAbsolute(var res: integer): boolean; // in MB
  173.  
  174.     function DiskSize: integer; // in MB
  175.     function DriveNumber: integer;
  176.   strict protected
  177.     function IsFAT: boolean;
  178.     procedure CheckDriveExisting;
  179.  
  180.     // will return NULL_GUID in case of an error or if it is not supported
  181.     function GetVolumeGUID: TGUID;
  182.     function GetVolumeGUIDAvailable: boolean;
  183.  
  184.     // TODO: get drive serial
  185.   public
  186.     constructor Create(ADriveLetter: AnsiChar);
  187.  
  188.     // Wenn UserSID='', dann werden alle Recycler gefunden
  189.     procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');
  190.  
  191.     property DriveLetter: AnsiChar read FDriveLetter;
  192.     property VolumeGUID: TGUID read GetVolumeGUID;
  193.     property VolumeGUIDAvailable: boolean read GetVolumeGUIDAvailable;
  194.     function GetAPIInfo: TSHQueryRBInfo;
  195.     function GetSize: int64;
  196.     function GetNumItems: int64;
  197.     function IsEmpty: boolean;
  198.  
  199.     function GetMaxPercentUsage: Extended; // 0..1
  200.     function GetMaxAbsoluteUsage: integer; // in MB
  201.     function GetNukeOnDelete: boolean;
  202.   end;
  203.  
  204.   GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
  205.  
  206.   TRecycleBinManager = class(TObject)
  207.   public
  208.     class procedure ListDrives(list: TObjectList{TRbDrive}); static;
  209.     class function RecycleBinPossible(Drive: AnsiChar): boolean; static;
  210.  
  211.     class function OwnRecyclersSize: int64; static;
  212.     class function OwnRecyclersNumItems: int64; static;
  213.     class function OwnRecyclersEmpty: boolean; static;
  214.  
  215.     class function EmptyOwnRecyclers(flags: cardinal): boolean; overload; static;
  216.     class function EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean; overload; static;
  217.  
  218.     class function RecyclerGetCurrentIconString: string; static;
  219.     class function RecyclerGetDefaultIconString: string; static;
  220.     class function RecyclerGetEmptyIconString: string; static;
  221.     class function RecyclerGetFullIconString: string; static;
  222.  
  223.     class function GetGlobalMaxPercentUsage: integer; static; // TODO: In Win Vista: absolute and not relative sizes
  224.     class function GetGlobalNukeOnDelete: boolean; static;
  225.     class function UsesGlobalSettings: boolean; static;
  226.  
  227.     class function RecyclerGetName: string; static;
  228.     class function RecyclerGetInfoTip: string; static;
  229.     class function RecyclerGetIntroText: string; static;
  230.  
  231.     class function RecyclerEmptyEventGetCurrentSound: string; static;
  232.     class function RecyclerEmptyEventGetDefaultSound: string; static;
  233.     class function RecyclerEmptyEventGetName: string; static;
  234.     class function RecyclerEmptyEventGetSound(ACategory: string): string; static;
  235.     class procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList); static;
  236.  
  237.     // TODO: In future also detect for other users
  238.     // TODO: Also make a setter (incl. Message to Windows Explorer?)
  239.     class function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL; static;
  240.     class function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL; static;
  241.     class function RecyclerGroupPolicyRecycleBinSize: integer; static;
  242.  
  243.     class function RecyclerConfirmationDialogEnabled: boolean; static;
  244.     class procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean); static;
  245.     class function RecyclerShellStateConfirmationDialogEnabled: boolean; static;
  246.  
  247.     // Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer
  248.     // 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben
  249.     // werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da
  250.     // unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:
  251.     // - RecyclerIsEmpty
  252.     // - RecyclerGetNumItems
  253.     // - RecyclerGetSize
  254.     // - RecyclerGetAPIInfo
  255.     class function RecyclerQueryFunctionAvailable: boolean; static;
  256.  
  257.     class function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean; static;
  258.   end;
  259.  
  260. function GPBoolToString(value: GPOLICYBOOL): string;
  261.  
  262. implementation
  263.  
  264. uses
  265.   RecBinUnitLowLvl;
  266.  
  267. {$REGION 'WinAPI/RTL declarations'}
  268. (*
  269. const
  270.   {$IFDEF MSWINDOWS}
  271.     shell32  = 'shell32.dll';
  272.     advapi32 = 'advapi32.dll';
  273.     kernel32 = 'kernel32.dll';
  274.   {$ENDIF}
  275.   {$IFDEF LINUX}
  276.     shell32  = 'libshell32.borland.so';
  277.     advapi32 = 'libwine.borland.so';
  278.     kernel32 = 'libwine.borland.so';
  279.   {$ENDIF}
  280. *)
  281.  
  282. type
  283.   SHELLSTATE = record
  284.     Flags1: DWORD;
  285. (*
  286.     BOOL fShowAllObjects : 1;
  287.     BOOL fShowExtensions : 1;
  288.     BOOL fNoConfirmRecycle : 1;
  289.  
  290.     BOOL fShowSysFiles : 1;
  291.     BOOL fShowCompColor : 1;
  292.     BOOL fDoubleClickInWebView : 1;
  293.     BOOL fDesktopHTML : 1;
  294.     BOOL fWin95Classic : 1;
  295.     BOOL fDontPrettyPath : 1;
  296.     BOOL fShowAttribCol : 1; // No longer used, dead bit
  297.     BOOL fMapNetDrvBtn : 1;
  298.     BOOL fShowInfoTip : 1;
  299.     BOOL fHideIcons : 1;
  300.     BOOL fWebView : 1;
  301.     BOOL fFilter : 1;
  302.     BOOL fShowSuperHidden : 1;
  303.     BOOL fNoNetCrawling : 1;
  304. *)
  305.     dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts
  306.     uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts
  307.  
  308.     // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM
  309.     lParamSort: Integer;
  310.     iSortDirection: Integer;
  311.  
  312.     version: UINT;
  313.  
  314.     // new for win2k. need notUsed var to calc the right size of ie4 struct
  315.     // FIELD_OFFSET does not work on bit fields
  316.     uNotUsed: UINT; // feel free to rename and use
  317.     Flags2: DWORD;
  318. (*
  319.     BOOL fSepProcess: 1;
  320.     // new for Whistler.
  321.     BOOL fStartPanelOn: 1;       //Indicates if the Whistler StartPanel mode is ON or OFF.
  322.     BOOL fShowStartPage: 1;      //Indicates if the Whistler StartPage on desktop is ON or OFF.
  323.     UINT fSpareFlags : 13;
  324. *)
  325.   end;
  326.   LPSHELLSTATE = ^SHELLSTATE;
  327.  
  328. const
  329.   // Masks for the SHELLSTATE
  330.   SSF_SHOWALLOBJECTS       = $00000001;
  331.   SSF_SHOWEXTENSIONS       = $00000002;
  332.   SSF_HIDDENFILEEXTS       = $00000004;
  333.   SSF_SERVERADMINUI        = $00000004;
  334.   SSF_SHOWCOMPCOLOR        = $00000008;
  335.   SSF_SORTCOLUMNS          = $00000010;
  336.   SSF_SHOWSYSFILES         = $00000020;
  337.   SSF_DOUBLECLICKINWEBVIEW = $00000080;
  338.   SSF_SHOWATTRIBCOL        = $00000100;
  339.   SSF_DESKTOPHTML          = $00000200;
  340.   SSF_WIN95CLASSIC         = $00000400;
  341.   SSF_DONTPRETTYPATH       = $00000800;
  342.   SSF_SHOWINFOTIP          = $00002000;
  343.   SSF_MAPNETDRVBUTTON      = $00001000;
  344.   SSF_NOCONFIRMRECYCLE     = $00008000;
  345.   SSF_HIDEICONS            = $00004000;
  346.   SSF_FILTER               = $00010000;
  347.   SSF_WEBVIEW              = $00020000;
  348.   SSF_SHOWSUPERHIDDEN      = $00040000;
  349.   SSF_SEPPROCESS           = $00080000;
  350.   SSF_NONETCRAWLING        = $00100000;
  351.   SSF_STARTPANELON         = $00200000;
  352.   SSF_SHOWSTARTPAGE        = $00400000;
  353. {$ENDREGION}
  354.  
  355. resourcestring
  356.   LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';
  357.   LNG_NOT_CALLABLE = '%s not callable';
  358.   LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s';
  359.   LNG_FILE_NOT_FOUND = 'File not found: %s';
  360.   LNG_INVALID_INFO_FORMAT = 'Unexpected record size: %s';
  361.   LNG_DRIVE_NOT_EXISTING = 'Drive %s does not exist.';
  362.  
  363. const
  364.   {$IFDEF UNICODE}
  365.   C_SHEmptyRecycleBin = 'SHEmptyRecycleBinW';
  366.   C_SHQueryRecycleBin = 'SHQueryRecycleBinW';
  367.   C_GetVolumeNameForVolumeMountPoint = 'GetVolumeNameForVolumeMountPointW';
  368.   {$ELSE}
  369.   C_SHEmptyRecycleBin = 'SHEmptyRecycleBinA';
  370.   C_SHQueryRecycleBin = 'SHQueryRecycleBinA';
  371.   C_GetVolumeNameForVolumeMountPoint = 'GetVolumeNameForVolumeMountPointA';
  372.   {$ENDIF}
  373.   C_SHGetSettings = 'SHGetSettings';
  374.   C_SHGetSetSettings = 'SHGetSetSettings';
  375.  
  376. type
  377.   TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
  378.   TGetVolumeNameForVolumeMountPoint = function(lpszVolumeMountPoint: LPCTSTR; lpszVolumeName: LPTSTR; cchBufferLength: DWORD): BOOL; stdcall;
  379.   TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: LPCTSTR; dwFlags: DWORD): HRESULT; stdcall;
  380.   TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD); stdcall;
  381.   TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL); stdcall;
  382.  
  383. procedure AnsiRemoveNulChars(var s: AnsiString);
  384. begin
  385.   while (Length(s) > 0) and (s[Length(s)] = #0) do
  386.     s := Copy(s, 1, Length(s)-1);
  387. end;
  388.  
  389. procedure UnicodeRemoveNulChars(var s: WideString);
  390. begin
  391.   while (Length(s) > 0) and (s[Length(s)] = #0) do
  392.     s := Copy(s, 1, Length(s)-1);
  393. end;
  394.  
  395. function GetDriveGUID(driveLetter: AnsiChar; var guid: TGUID): DWORD;
  396. var
  397.   Buffer: array[0..50] of Char;
  398.   x: string;
  399.   PGetVolumeNameForVolumeMountPoint: TGetVolumeNameForVolumeMountPoint;
  400.   RBHandle: THandle;
  401. begin
  402.   RBHandle := LoadLibrary(kernel32);
  403.   try
  404.     if RBHandle <> 0 then
  405.     begin
  406.       PGetVolumeNameForVolumeMountPoint := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);
  407.       if not Assigned(@PGetVolumeNameForVolumeMountPoint) then
  408.       begin
  409.         result := GetLastError;
  410.         FreeLibrary(RBHandle);
  411.         RBHandle := 0;
  412.       end
  413.       else
  414.       begin
  415.         if PGetVolumeNameForVolumeMountPoint(PChar(driveLetter+':\'), Buffer, SizeOf(Buffer)) then
  416.         begin
  417.           x := string(buffer);
  418.           x := copy(x, 11, 38);
  419.           guid := StringToGUID(x);
  420.           result := ERROR_SUCCESS;
  421.         end
  422.         else
  423.           result := GetLastError;
  424.       end;
  425.     end
  426.     else result := GetLastError;
  427.   finally
  428.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  429.   end;
  430. end;
  431.  
  432. function FileTimeToDateTime(FileTime: FILETIME): TDateTime;
  433. {$IFDEF FILETIME_DELPHI_CODE}
  434. var
  435.   SystemTime: TSystemTime;
  436.   nowUTC: TDateTime;
  437.   gmtDifference: int64;
  438. begin
  439.   GetSystemTime(SystemTime);
  440.   with SystemTime do
  441.   begin
  442.     // http://www.delphipraxis.net/post340194.html#34019
  443.     nowUTC := EncodeDate(wYear, wMonth, wDay) +
  444.               EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
  445.   end;
  446.  
  447.   gmtDifference := datetimetounix(nowUTC) - datetimetounix(Now);
  448.  
  449.   // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf states:
  450.   // UnixTime = 0.0000001 * NTTime + 11644473600
  451.   // This is wrong! The correct formula is:
  452.   // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600
  453.   // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)
  454.   result := unixtodatetime(round(0.0000001 * int64(FileTime)) - 11644473600 - gmtDifference);
  455. {$ELSE}
  456. var
  457.   LocalTime: TFileTime;
  458.   DOSTime: Integer;
  459. begin
  460.   FileTimeToLocalFileTime(FileTime, LocalTime);
  461.   FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo);
  462.   Result := FileDateToDateTime(DOSTime);
  463. {$ENDIF}
  464. end;
  465.  
  466. function DeleteDirectory(const Name: string): boolean;
  467. var
  468.   F: TSearchRec;
  469. begin
  470.   result := true;
  471.   if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then
  472.   begin
  473.     try
  474.       repeat
  475.         if F.Attr and faDirectory <> 0 then
  476.         begin
  477.           if (F.Name <> '.') and (F.Name <> '..') then
  478.           begin
  479.             result := result and DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);
  480.           end;
  481.         end
  482.         else
  483.         begin
  484.           if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;
  485.         end;
  486.       until FindNext(F) <> 0;
  487.     finally
  488.       FindClose(F);
  489.     end;
  490.     if not RemoveDir(Name) then result := false;
  491.   end;
  492. end;
  493.  
  494. function DriveLetterToDriveNumber(driveLetter: AnsiChar): integer;
  495. var
  496.   tmp: string;
  497. begin
  498.   tmp := LowerCase(string(driveLetter));
  499.   result := Ord(tmp[1])-Ord('a');
  500. end;
  501.  
  502. function GetStringFromDLL(filename: string; num: integer): string;
  503. const
  504.   // Source: http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp
  505.   MAX_BUF = 4097; // OK?
  506. var
  507.   hLib: THandle;
  508.   buf: array[0..MAX_BUF] of char;
  509. begin
  510.   hLib := LoadLibrary(PChar(filename));
  511.   try
  512.     LoadString(hLib, num, buf, sizeof(buf));
  513.     result := buf;
  514.   finally
  515.     FreeLibrary(hLib);
  516.   end;
  517. end;
  518.  
  519. function ExpandEnvStr(const szInput: string): string;
  520. const
  521.   MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
  522. begin
  523.   // Source: http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html
  524.   SetLength(Result,MAXSIZE);
  525.   SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
  526.     @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
  527. end;
  528.  
  529. function DecodeReferenceString(s: string): string;
  530. var
  531.   dll, id, lang, cache: string;
  532.   sl, sl2: tstringlist;
  533. begin
  534.   // Beispiele
  535.   // Papierkorb                                                 -- Windows 95
  536.   // @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000
  537.  
  538.   if Copy(s, 1, 1) = '@' then
  539.   begin
  540.     // Referenz auf eine DLL
  541.     // @<dll>,-<id>[@<lang>][,<cache>]
  542.  
  543.     sl := TStringList.Create;
  544.     try
  545.       // '@' am Anfang entfernen
  546.       s := Copy(s, 2, length(s)-1);
  547.  
  548.       // Nach ',' auftrennen
  549.       // sl[0] --> dll
  550.       // sl[1] --> -id@lang
  551.       // sl[2] --> cache
  552.       sl.CommaText := s;
  553.  
  554.       if sl.Count > 2 then
  555.       begin
  556.         // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden
  557.         // Ist bei Windows 2000 der Fall
  558.         cache := sl[2];
  559.         result := cache;
  560.         exit;
  561.       end;
  562.  
  563.       if sl.Count > 1 then
  564.       begin
  565.         dll := sl[0];
  566.  
  567.         sl2 := TStringList.Create;
  568.         try
  569.           // Nach '@' auftrennen
  570.           // sl2[0] --> id
  571.           // sl2[1] --> lang
  572.           sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);
  573.  
  574.           id := sl2[0];
  575.  
  576.           if sl2.Count > 1 then
  577.           begin
  578.             // ToDo: In Zukunft beachten, sofern möglich
  579.             lang := sl2[1];
  580.           end;
  581.  
  582.           // Umgebungsvariablen erkennen und Minuszeichen entfernen
  583.           result := GetStringFromDLL(ExpandEnvStr(dll), -StrToInt(id));
  584.         finally
  585.           sl2.Free;
  586.         end;
  587.       end
  588.       else
  589.       begin
  590.         // Zu wenige Informationen!
  591.  
  592.         result := '';
  593.       end;
  594.     finally
  595.       sl.Free;
  596.     end;
  597.   end
  598.   else
  599.   begin
  600.     // Kein Hinweis auf eine Referenz
  601.     result := s;
  602.   end;
  603. end;
  604.  
  605. function GPBoolToString(value: GPOLICYBOOL): string;
  606. begin
  607.   case value of
  608.     gpUndefined: result := 'Not configured';
  609.     gpEnabled: result := 'Enabled';
  610.     gpDisabled: result := 'Disabled';
  611.   end;
  612. end;
  613.  
  614. { TRbRecycleBin }
  615.  
  616. constructor TRbRecycleBin.Create(AFileOrDirectory: string; ASID: string='');
  617. begin
  618.   inherited Create;
  619.  
  620.   FFileOrDirectory := AFileOrDirectory;
  621.   FSID := ASID;
  622.   TolerantReading := true;
  623. end;
  624.  
  625. // TODO: also a function that tests if the data files are still existing
  626. function TRbRecycleBin.CheckIndexes(slErrors: TStrings): boolean;
  627.  
  628.   procedure _Assert(assertion: boolean; msg: string; args: array of const);
  629.   begin
  630.     if not assertion then
  631.     begin
  632.       slErrors.Add(Format(msg, args));
  633.       result := false;
  634.     end;
  635.   end;
  636.  
  637.   procedure _HandleIndexFile(AFile: string);
  638.   var
  639.     fs: TFileStream;
  640.     infoHdr: TRbInfoHeader;
  641.   resourcestring
  642.     LNG_IDXERR_VISTA_FILESIZE = '%s: Vista index file has wrong size';
  643.     LNG_IDXERR_INFO_RECSIZE_UNEXPECTED = '%s: record size unexpected';
  644.     LNG_IDXERR_INFO_UNEXPECTED_EOF = '%s: file size wrong';
  645.   begin
  646.     fs := TFileStream.Create(AFile, fmOpenRead);
  647.     try
  648.       fs.Seek(0, soFromBeginning);
  649.  
  650.       if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then
  651.       begin
  652.         _Assert(fs.Size = SizeOf(TRbVistaItem), LNG_IDXERR_VISTA_FILESIZE, [AFile]);
  653.       end
  654.       else if SameText(ExtractFileName(AFile), 'INFO') or
  655.               SameText(ExtractFileName(AFile), 'INFO2') then
  656.       begin
  657.         fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  658.         _Assert((infoHdr.recordLength = SizeOf(TRbInfoRecordA)) or
  659.                 (infoHdr.recordLength = SizeOf(TRbInfoRecordW)), LNG_IDXERR_INFO_RECSIZE_UNEXPECTED, [AFile]);
  660.         _Assert((fs.Size-fs.Position) mod infoHdr.recordLength = 0, LNG_IDXERR_INFO_UNEXPECTED_EOF, [AFile]);
  661.         // TODO: we can also check infoHdr.totalSize or infoHdr.totalEntries
  662.       end
  663.       else Assert(false);
  664.  
  665.       // TODO: we could check each item for invalid stuff...?
  666.     finally
  667.       FreeAndNil(fs);
  668.     end;
  669.   end;
  670.  
  671.   procedure _HandleVistaDir(ADirectory: string);
  672.   var
  673.     SR: TSearchRec;
  674.   begin
  675.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  676.  
  677.     if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
  678.     begin
  679.       repeat
  680.         _HandleIndexFile(ADirectory+sr.Name);
  681.       until FindNext(SR) <> 0;
  682.     end;
  683.     FindClose(SR);
  684.   end;
  685.  
  686. begin
  687.   result := true;
  688.  
  689.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  690.   begin
  691.     _HandleVistaDir(FFileOrDirectory);
  692.  
  693.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  694.     begin
  695.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  696.     end;
  697.  
  698.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  699.     begin
  700.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  701.     end;
  702.   end
  703.   else if FileExists(FFileOrDirectory) then
  704.   begin
  705.     _HandleIndexFile(FFileOrDirectory);
  706.   end
  707.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  708. end;
  709.  
  710. function TRbRecycleBin.GetItem(id: string): TRbRecycleBinItem;
  711.  
  712.   procedure _HandleIndexFile(AFile: string);
  713.   var
  714.     fs: TFileStream;
  715.     infoHdr: TRbInfoHeader;
  716.     testItem: TRbRecycleBinItem;
  717.   begin
  718.     fs := TFileStream.Create(AFile, fmOpenRead);
  719.     try
  720.       fs.Seek(0, soFromBeginning);
  721.  
  722.       if SameText(ExtractFileName(AFile), '$I'+id) then
  723.       begin
  724.         result := TRbVistaItem.Create(fs, AFile, id);
  725.       end
  726.       else
  727.       begin
  728.         fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  729.         case infoHdr.recordLength of
  730.           SizeOf(TRbInfoRecordA):
  731.           begin
  732.             while fs.Position < fs.size do
  733.             begin
  734.               testItem := TRbInfoAItem.Create(fs, AFile);
  735.               if testItem.ID = id then
  736.               begin
  737.                 result := testItem;
  738.                 break;
  739.               end;
  740.             end;
  741.           end;
  742.           SizeOf(TRbInfoRecordW):
  743.           begin
  744.             while fs.Position < fs.size do
  745.             begin
  746.               testItem := TRbInfoWItem.Create(fs, AFile);
  747.               if testItem.ID = id then
  748.               begin
  749.                 result := testItem;
  750.                 break;
  751.               end;
  752.             end;
  753.           end
  754.           else
  755.           begin
  756.             raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]);
  757.           end;
  758.         end;
  759.       end;
  760.     finally
  761.       FreeAndNil(fs);
  762.     end;
  763.   end;
  764.  
  765.   procedure _HandleVistaDir(ADirectory: string);
  766.   var
  767.     SR: TSearchRec;
  768.     fs: TFileStream;
  769.     id: string;
  770.   begin
  771.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  772.  
  773.     if FileExists(ADirectory + '$I' + id) then
  774.     begin
  775.       fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);
  776.       try
  777.         fs.Seek(0, soFromBeginning);
  778.         result := TRbVistaItem.Create(fs, ADirectory+sr.Name, id);
  779.       finally
  780.         FreeAndNil(fs);
  781.       end;
  782.     end;
  783.   end;
  784.  
  785. begin
  786.   result := nil;
  787.  
  788.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  789.   begin
  790.     _HandleVistaDir(FFileOrDirectory);
  791.     if Assigned(result) then exit;
  792.  
  793.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  794.     begin
  795.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  796.       if Assigned(result) then exit;
  797.     end;
  798.  
  799.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  800.     begin
  801.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  802.       if Assigned(result) then exit;
  803.     end;
  804.   end
  805.   else if FileExists(FFileOrDirectory) then
  806.   begin
  807.     _HandleIndexFile(FFileOrDirectory);
  808.     if Assigned(result) then exit;
  809.   end
  810.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  811. end;
  812.  
  813. procedure TRbRecycleBin.ListItems(list: TObjectList{TRbRecycleBinItem});
  814.  
  815.   procedure _HandleIndexFile(AFile: string);
  816.   var
  817.     fs: TFileStream;
  818.     infoHdr: TRbInfoHeader;
  819.     vistaId: string;
  820.     wTest: TRbInfoWItem;
  821.     bakPosition: int64;
  822.     testVistaItem: TRbVistaItem;
  823.   begin
  824.     fs := TFileStream.Create(AFile, fmOpenRead);
  825.     try
  826.       fs.Seek(0, soFromBeginning);
  827.  
  828.       {$REGION 'First try if it is a Vista index file'}
  829.       testVistaItem := nil;
  830.       if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then
  831.       begin
  832.         vistaId := copy(AFile, 3, Length(AFile)-2);
  833.         testVistaItem := TRbVistaItem.Create(fs, AFile, vistaId);
  834.       end
  835.       else
  836.       begin
  837.         vistaId := ''; // manual file that was not named $I..., so we cannot get $R... ID and therefore no physical file!
  838.         try
  839.           testVistaItem := TRbVistaItem.Create(fs, AFile, vistaId);
  840.           if (Copy(testVistaItem.Source,2,2) <> ':\') and
  841.              (Copy(testVistaItem.Source,2,2) <> '\\') then
  842.             FreeAndNil(testVistaItem);
  843.         except
  844.           testVistaItem := nil;
  845.         end;
  846.       end;
  847.       {$ENDREGION}
  848.  
  849.       if Assigned(testVistaItem) then
  850.       begin
  851.         list.Add(testVistaItem);
  852.       end
  853.       else
  854.       begin
  855.         fs.Seek(0, soFromBeginning);
  856.         if TolerantReading then
  857.         begin
  858.           // This is a special treatment how to recover data from an INFO/INFO2 file
  859.           // which was corrupted by an incompatible multiboot configuration.
  860.           // Example:
  861.           // - Win95 without IE4 and WinNT4 both write into the INFO file. But Win95 appends the ANSI record and WinNT appends an Unicode record.
  862.           // - Win95 with IE4 and Windows 2000/2003/XP write into the INFO2 file. But Win9x appends the ANSI record and Win2k+ appends an Unicode record.
  863.           fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  864.           while fs.Position < fs.size do
  865.           begin
  866.             // Can we actually read a Unicode record?
  867.             if fs.Position + SizeOf(TRbInfoRecordW) <= fs.Size then
  868.             begin
  869.               // Try to read the Unicode record and check if it is valid
  870.               // In case it is no Unicode record, then the Unicode part will be the
  871.               // ANSI source name of the next record. In this case, we won't get
  872.               // a ':\' or '\\' at the Unicode string.
  873.               bakPosition := fs.Position;
  874.               wTest := TRbInfoWItem.Create(fs, AFile);
  875.               if (Copy(wTest.SourceUnicode, 2, 2) = ':\') or
  876.                  (Copy(wTest.SourceUnicode, 2, 2) = '\\') then
  877.               begin
  878.                 // Yes, it is a valid Unicode record.
  879.                 list.Add(wTest);
  880.               end
  881.               else
  882.               begin
  883.                 // No, it is not a valid Unicode record. Jump back, and we need
  884.                 // to assume that the following record will be a valid ANSI record.
  885.                 fs.Position := bakPosition;
  886.                 list.Add(TRbInfoAItem.Create(fs, AFile));
  887.               end;
  888.             end
  889.             else if fs.Position + SizeOf(TRbInfoRecordA) <= fs.Size then
  890.             begin
  891.               // No, there is not enough space left for an Unicode record.
  892.               // So we assume that the following record will be a valid ANSI record.
  893.               list.Add(TRbInfoAItem.Create(fs, AFile));
  894.             end
  895.             else
  896.             begin
  897.               // Not enough space to read a ANSI record!
  898.               // Ignore it
  899.             end;
  900.           end;
  901.         end
  902.         else
  903.         begin
  904.           // This is the code for non-tolerant reading of the records.
  905.           fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  906.           case infoHdr.recordLength of
  907.             SizeOf(TRbInfoRecordA):
  908.             begin
  909.               while fs.Position < fs.size do
  910.               begin
  911.                 list.Add(TRbInfoAItem.Create(fs, AFile));
  912.               end;
  913.             end;
  914.             SizeOf(TRbInfoRecordW):
  915.             begin
  916.               while fs.Position < fs.size do
  917.               begin
  918.                 list.Add(TRbInfoWItem.Create(fs, AFile));
  919.               end;
  920.             end
  921.             else
  922.             begin
  923.               raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]);
  924.             end;
  925.           end;
  926.         end;
  927.       end;
  928.     finally
  929.       FreeAndNil(fs);
  930.     end;
  931.   end;
  932.  
  933.   procedure _HandleVistaDir(ADirectory: string);
  934.   var
  935.     SR: TSearchRec;
  936.     fs: TFileStream;
  937.     id: string;
  938.   begin
  939.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  940.  
  941.     if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
  942.     begin
  943.       repeat
  944.         id := sr.Name;
  945.         { id := ChangeFileExt(id, ''); }  // Removed code: We keep the file extention as part of the ID, because we do not know if the ID is otherwise unique
  946.         id := Copy(id, 3, Length(id)-2);
  947.  
  948.         fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);
  949.         try
  950.           fs.Seek(0, soFromBeginning);
  951.           list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id));
  952.         finally
  953.           FreeAndNil(fs);
  954.         end;
  955.       until FindNext(SR) <> 0;
  956.     end;
  957.     FindClose(SR);
  958.   end;
  959.  
  960. begin
  961.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  962.   begin
  963.     _HandleVistaDir(FFileOrDirectory);
  964.  
  965.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  966.     begin
  967.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  968.     end;
  969.  
  970.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  971.     begin
  972.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  973.     end;
  974.   end
  975.   else if FileExists(FFileOrDirectory) then
  976.   begin
  977.     _HandleIndexFile(FFileOrDirectory); // Either INFO, or INFO2, or a single Vista index file
  978.   end
  979.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  980. end;
  981.  
  982. { TRbDrive }
  983.  
  984. procedure TRbDrive.CheckDriveExisting;
  985. begin
  986.   // Does the drive exist?
  987.   // see http://www.delphipraxis.net/post2933.html
  988.   if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then
  989.   begin
  990.     raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(string(FDriveLetter))+':']);
  991.   end;
  992. end;
  993.  
  994. constructor TRbDrive.Create(ADriveLetter: AnsiChar);
  995. begin
  996.   inherited Create;
  997.  
  998.   FDriveLetter := ADriveLetter;
  999.   CheckDriveExisting;
  1000. end;
  1001.  
  1002. function TRbDrive.DiskSize: integer;
  1003. begin
  1004.   result := SysUtils.DiskSize(DriveNumber+1 {0 is current, 1 is A}) div (1024*1024);
  1005. end;
  1006.  
  1007. function TRbDrive.DriveNumber: integer;
  1008. begin
  1009.   result := DriveLetterToDriveNumber(FDriveLetter);
  1010. end;
  1011.  
  1012. function TRbDrive.GetAPIInfo: TSHQueryRBInfo;
  1013. var
  1014.   PSHQueryRecycleBin: TSHQueryRecycleBin;
  1015.   RBHandle: THandle;
  1016.   res: HRESULT;
  1017.   Path: string;
  1018. begin
  1019.   Path := FDriveLetter + ':\';
  1020.  
  1021.   // Ref: http://www.delphipraxis.net/post1291.html
  1022.  
  1023.   RBHandle := LoadLibrary(shell32);
  1024.   try
  1025.     PSHQueryRecycleBin := nil;
  1026.     if RBHandle <> 0 then
  1027.     begin
  1028.       PSHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
  1029.       if not Assigned(@PSHQueryRecycleBin) then
  1030.       begin
  1031.         FreeLibrary(RBHandle);
  1032.         RBHandle := 0;
  1033.       end;
  1034.     end;
  1035.  
  1036.     FillChar(result, SizeOf(TSHQueryRBInfo), 0);
  1037.     result.cbSize := SizeOf(TSHQueryRBInfo);
  1038.  
  1039.     if (RBHandle <> 0) and Assigned(PSHQueryRecycleBin) then
  1040.     begin
  1041.       res := PSHQueryRecycleBin(PChar(Path), result);
  1042.       // if Succeeded(res) then
  1043.       if res = S_OK then
  1044.       begin
  1045.         // Alles OK, unser result hat nun die gewünschten Daten.
  1046.       end
  1047.       else
  1048.       begin
  1049.         // Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)
  1050.         // if Path is a floppy or CD drive...
  1051.         raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);
  1052.       end;
  1053.     end
  1054.     else
  1055.       raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);
  1056.   finally
  1057.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  1058.   end;
  1059. end;
  1060.  
  1061. function TRbDrive.GetMaxPercentUsage: Extended;
  1062. var
  1063.   abs: integer; // in MB
  1064.   rel: integer; // in % (0-100)
  1065.   gpSetting: integer;
  1066. const
  1067.   DEFAULT_PERCENT = 10; // Windows 95 default
  1068. begin
  1069.   gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
  1070.   if gpSetting <> -1 then
  1071.     result := gpSetting / 100
  1072.   else if TRecycleBinManager.UsesGlobalSettings then
  1073.     result := TRecycleBinManager.GetGlobalMaxPercentUsage / 100
  1074.   else if OldCapacityPercent(rel) then
  1075.   begin
  1076.     result := rel / 100;
  1077.   end
  1078.   else if NewCapacityAbsolute(abs) then
  1079.   begin
  1080.     result := abs / DiskSize;
  1081.   end
  1082.   else
  1083.   begin
  1084.     result := DEFAULT_PERCENT / 100;
  1085.   end;
  1086. end;
  1087.  
  1088. function TRbDrive.GetMaxAbsoluteUsage: integer;
  1089. var
  1090.   abs: integer; // in MB
  1091.   rel: integer; // in % (0-100)
  1092.   gpSetting: integer;
  1093. const
  1094.   DEFAULT_PERCENT = 10; // Windows 95 default
  1095. begin
  1096.   gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
  1097.   if gpSetting <> -1 then
  1098.     result := Ceil(gpSetting/100 * DiskSize)
  1099.   else if TRecycleBinManager.UsesGlobalSettings then
  1100.     result := Ceil(TRecycleBinManager.GetGlobalMaxPercentUsage/100 * DiskSize)
  1101.   else if NewCapacityAbsolute(abs) then
  1102.   begin
  1103.     result := abs;
  1104.   end
  1105.   else if OldCapacityPercent(rel) then
  1106.   begin
  1107.     result := Ceil(rel/100 * DiskSize);
  1108.   end
  1109.   else
  1110.   begin
  1111.     result := Ceil(DEFAULT_PERCENT/100 * DiskSize);
  1112.   end;
  1113. end;
  1114.  
  1115. function TRbDrive.OldCapacityPercent(var res: integer): boolean;
  1116. var
  1117.   reg: TRegistry;
  1118.   purgeInfo: TRbWin95PurgeInfo;
  1119. begin
  1120.   if Win32MajorVersion >= 6 then
  1121.   begin
  1122.     // Only available till Windows XP
  1123.     result := false;
  1124.     exit;
  1125.   end;
  1126.  
  1127.   result := false;
  1128.  
  1129.   reg := TRegistry.Create;
  1130.   try
  1131.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1132.  
  1133.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1134.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1135.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1136.     begin
  1137.       if reg.OpenKeyReadOnly(string(FDriveLetter)) then
  1138.       begin
  1139.         if reg.ValueExists('Percent') then
  1140.         begin
  1141.           // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1142.  
  1143.           res := reg.ReadInteger('Percent');
  1144.           result := true;
  1145.         end;
  1146.       end
  1147.       else
  1148.       begin
  1149.         if reg.ValueExists('PurgeInfo') then
  1150.         begin
  1151.           // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1152.  
  1153.           reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1154.  
  1155.           res := purgeInfo.percentDrive[FDriveLetter];
  1156.           result := true;
  1157.         end;
  1158.       end;
  1159.  
  1160.       reg.CloseKey;
  1161.     end;
  1162.   finally
  1163.     reg.Free;
  1164.   end;
  1165. end;
  1166.  
  1167. function TRbDrive.NewCapacityAbsolute(var res: integer): boolean;
  1168. var
  1169.   reg: TRegistry;
  1170. begin
  1171.   if Win32MajorVersion < 6 then
  1172.   begin
  1173.     // Only available since Windows Vista
  1174.     result := false;
  1175.     exit;
  1176.   end;
  1177.  
  1178.   result := false;
  1179.  
  1180.   reg := TRegistry.Create;
  1181.   try
  1182.     reg.RootKey := HKEY_CURRENT_USER;
  1183.  
  1184.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
  1185.     begin
  1186.       // Windows Vista and upwards
  1187.       if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
  1188.       begin
  1189.         res := reg.ReadInteger('MaxCapacity'); // in MB
  1190.         result := true;
  1191.       end;
  1192.       reg.CloseKey;
  1193.     end;
  1194.   finally
  1195.     reg.Free;
  1196.   end;
  1197. end;
  1198.  
  1199. function TRbDrive.GetNukeOnDelete: boolean;
  1200. var
  1201.   reg: TRegistry;
  1202.   purgeInfo: TRbWin95PurgeInfo;
  1203. const
  1204.   RES_DEFAULT = false; // Windows 95 default
  1205. begin
  1206.   if TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
  1207.     result := true
  1208.   else if TRecycleBinManager.UsesGlobalSettings then
  1209.     result := TRecycleBinManager.GetGlobalNukeOnDelete
  1210.   else
  1211.   begin
  1212.     result := RES_DEFAULT;
  1213.  
  1214.     reg := TRegistry.Create;
  1215.     try
  1216.       reg.RootKey := HKEY_CURRENT_USER;
  1217.  
  1218.       if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
  1219.       begin
  1220.         // Windows Vista and upwards
  1221.         if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
  1222.         begin
  1223.           result := reg.ReadBool('NukeOnDelete');
  1224.         end;
  1225.         reg.CloseKey;
  1226.       end
  1227.       else
  1228.       begin
  1229.         reg.RootKey := HKEY_LOCAL_MACHINE;
  1230.  
  1231.         // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1232.         // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1233.         if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1234.         begin
  1235.           if reg.OpenKeyReadOnly(string(FDriveLetter)) then
  1236.           begin
  1237.             if reg.ValueExists('NukeOnDelete') then
  1238.             begin
  1239.               // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1240.  
  1241.               result := reg.ReadBool('NukeOnDelete');
  1242.             end;
  1243.           end
  1244.           else
  1245.           begin
  1246.             if reg.ValueExists('PurgeInfo') then
  1247.             begin
  1248.               // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1249.  
  1250.               reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1251.  
  1252.               result := ((purgeInfo.NukeOnDeleteBits shr DriveNumber) and 1) = 1;
  1253.             end;
  1254.           end;
  1255.  
  1256.           reg.CloseKey;
  1257.         end;
  1258.       end;
  1259.     finally
  1260.       reg.Free;
  1261.     end;
  1262.   end;
  1263. end;
  1264.  
  1265. function TRbDrive.GetNumItems: int64;
  1266. begin
  1267.   result := GetAPIInfo.i64NumItems;
  1268. end;
  1269.  
  1270. function TRbDrive.GetSize: int64;
  1271. begin
  1272.   result := GetAPIInfo.i64Size;
  1273. end;
  1274.  
  1275. function TRbDrive.GetVolumeGUID: TGUID;
  1276. begin
  1277.   if GetDriveGUID(FDriveLetter, result) <> ERROR_SUCCESS then
  1278.   begin
  1279.     result := NULL_GUID;
  1280.   end;
  1281. end;
  1282.  
  1283. function TRbDrive.GetVolumeGUIDAvailable: boolean;
  1284. begin
  1285.   result := not IsEqualGUID(VolumeGUID, NULL_GUID);
  1286. end;
  1287.  
  1288. function TRbDrive.IsEmpty: boolean;
  1289. begin
  1290.   result := GetNumItems = 0;
  1291. end;
  1292.  
  1293. function TRbDrive.IsFAT: boolean;
  1294. var
  1295.   Dummy2: DWORD;
  1296.   Dummy3: DWORD;
  1297.   FileSystem: array[0..MAX_PATH-1] of char;
  1298.   VolumeName: array[0..MAX_PATH-1] of char;
  1299.   s: string;
  1300. begin
  1301.   s := FDriveLetter + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll
  1302.   GetVolumeInformation(PChar(s), VolumeName,
  1303.     SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem));
  1304.   result := uppercase(copy(FileSystem, 0, 3)) = 'FAT';
  1305. end;
  1306.  
  1307. procedure TRbDrive.ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');
  1308.  
  1309.   procedure _AddSIDFolders(dir: string; wholeFolder: boolean);
  1310.   var
  1311.     SR: TSearchRec;
  1312.   begin
  1313.     dir := IncludeTrailingPathDelimiter(dir);
  1314.     if FindFirst(dir+'S-*', faAnyFile, SR) = 0 then
  1315.     begin
  1316.       try
  1317.         repeat
  1318.           if (SR.Name = '.') or (SR.Name = '..') or not DirectoryExists(dir + SR.Name) then continue;
  1319.  
  1320.           if wholeFolder then
  1321.           begin
  1322.             // Vista
  1323.             list.Add(TRbRecycleBin.Create(dir+SR.Name, SR.Name));
  1324.           end
  1325.           else
  1326.           begin
  1327.             // Win95 .. WinXP
  1328.             if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2') then
  1329.               list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2', SR.Name));
  1330.             if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO') then
  1331.               list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO', SR.Name));
  1332.           end;
  1333.         until FindNext(SR) <> 0;
  1334.       finally
  1335.         FindClose(SR);
  1336.       end;
  1337.     end;
  1338.   end;
  1339.  
  1340. var
  1341.   dir: string;
  1342. begin
  1343.   // Find recyclers from Windows Vista or higher
  1344.  
  1345.   if IsFAT then
  1346.   begin
  1347.     dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim;
  1348.     if DirectoryExists(dir) then
  1349.     begin
  1350.       list.Add(TRbRecycleBin.Create(dir));
  1351.     end;
  1352.   end
  1353.   else
  1354.   begin
  1355.     if UserSID <> '' then
  1356.     begin
  1357.       dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim + UserSID + PathDelim;
  1358.       if DirectoryExists(dir) then
  1359.       begin
  1360.         list.Add(TRbRecycleBin.Create(dir, UserSID));
  1361.       end;
  1362.     end
  1363.     else
  1364.     begin
  1365.       _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + '$recycle.bin', true);
  1366.     end;
  1367.   end;
  1368.  
  1369.   // Find recyclers from Windows before Vista
  1370.  
  1371.   if IsFAT then
  1372.   begin
  1373.     dir := FDriveLetter + DriveDelim + PathDelim + 'Recycled' + PathDelim;
  1374.  
  1375.     // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them)
  1376.     if FileExists(dir + 'INFO2') then
  1377.       list.Add(TRbRecycleBin.Create(dir + 'INFO2')); // Windows 95 with Internet Explorer 4 Extension or higher Windows 9x versions
  1378.     if FileExists(dir + 'INFO') then
  1379.       list.Add(TRbRecycleBin.Create(dir + 'INFO')); // Windows 95 native
  1380.   end
  1381.   else
  1382.   begin
  1383.     if UserSID <> '' then
  1384.     begin
  1385.       dir := FDriveLetter + DriveDelim + PathDelim + 'Recycler' + PathDelim + UserSID + PathDelim;
  1386.  
  1387.       if FileExists(dir + 'INFO2') then
  1388.         list.Add(TRbRecycleBin.Create(dir + 'INFO2', UserSID)); // Windows 2000+
  1389.       if FileExists(dir + 'INFO') then
  1390.         list.Add(TRbRecycleBin.Create(dir + 'INFO', UserSID)); // Windows NT 4
  1391.     end
  1392.     else
  1393.     begin
  1394.       _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + 'Recycler', false);
  1395.     end;
  1396.   end;
  1397. end;
  1398.  
  1399. { TRbInfoAItem }
  1400.  
  1401. procedure TRbInfoAItem.ReadFromStream(stream: TStream);
  1402. var
  1403.   r: TRbInfoRecordA;
  1404.   i: Integer;
  1405. begin
  1406.   stream.ReadBuffer(r, SizeOf(r));
  1407.  
  1408.   if r.sourceDrive = 26 then
  1409.     FSourceDrive := '@' // @ is the "Network home drive" of the Win95 time
  1410.   else
  1411.     FSourceDrive := Chr(Ord('A') + r.sourceDrive);
  1412.  
  1413.   // Win95 with IE4 and Win2000+:
  1414.   // Wenn ein Eintrag aus der INFO/INFO2 gelöscht wird, dann wird das erste Byte
  1415.   // von sourceAnsi auf Null gesetzt, damit die ganze INFO/INFO2 Datei nicht
  1416.   // ständig neu geschrieben werden muss (so wie es bei Win95 und WinNT4 der Fall war).
  1417.   // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
  1418.   // Zwecken eingesetzt werden soll.
  1419.   if r.sourceAnsi[0] = #0 then
  1420.   begin
  1421.     FRemovedEntry := true;
  1422.     r.sourceAnsi[0] := AnsiChar(FSourceDrive);
  1423.   end;
  1424.  
  1425.   FSourceAnsi := r.sourceAnsi;
  1426.  
  1427.   // Unicode does not exist in INFO(1) structure
  1428.   (* FSourceUnicode := AnsiCharArrayToWideString(r.sourceAnsi); *)
  1429.   SetLength(FSourceUnicode, Length(r.sourceAnsi));
  1430.   for i := 0 to Length(r.sourceAnsi)-1 do
  1431.     FSourceUnicode[i+1] := WideChar(r.sourceAnsi[i]);
  1432.  
  1433.   FID := IntToStr(r.recordNumber);
  1434.   FDeletionTime := FileTimeToDateTime(r.deletionTime);
  1435.   FOriginalSize := r.originalSize;
  1436.  
  1437.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1438.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1439.   AnsiRemoveNulChars(FSourceAnsi);
  1440.   UnicodeRemoveNulChars(FSourceUnicode);
  1441. end;
  1442.  
  1443. function TRbInfoAItem.DeleteFile: boolean;
  1444. var
  1445.   r: string;
  1446. begin
  1447.   r := GetPhysicalFile;
  1448.   if DirectoryExists(r) then
  1449.     result := DeleteDirectory(r) // Usually, the old recycle bin does not allow folders. Just to be sure, we include the code.
  1450.   else
  1451.     result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung? --> Win95: Funktioniert
  1452.  
  1453.   // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Datei neu schreiben)
  1454. end;
  1455.  
  1456. function TRbInfoAItem.GetPhysicalFile: string;
  1457. begin
  1458.   if FRemovedEntry then
  1459.   begin
  1460.     result := '';
  1461.     Exit;
  1462.   end;
  1463.  
  1464.   // e.g. C:\...\DC0.doc
  1465.   result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
  1466.             'D' + (* SourceDrive *) Source[1] + ID + ExtractFileExt(Source);
  1467. end;
  1468.  
  1469. constructor TRbInfoAItem.Create(fs: TStream; AIndexFile: string);
  1470. begin
  1471.   inherited Create;
  1472.   ReadFromStream(fs);
  1473.   FIndexFile := AIndexFile;
  1474. end;
  1475.  
  1476. { TRbInfoWItem }
  1477.  
  1478. procedure TRbInfoWItem.ReadFromStream(stream: TStream);
  1479. var
  1480.   r: TRbInfoRecordW;
  1481. begin
  1482.   stream.ReadBuffer(r, SizeOf(r));
  1483.  
  1484.   // Win95 with IE4 and Win2000+:
  1485.   // Wenn ein Eintrag aus der INFO/INFO2 gelöscht wird, dann wird das erste Byte
  1486.   // von sourceAnsi auf Null gesetzt, damit die ganze INFO/INFO2 Datei nicht
  1487.   // ständig neu geschrieben werden muss (so wie es bei Win95 und WinNT4 der Fall war).
  1488.   // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
  1489.   // Zwecken eingesetzt werden soll.
  1490.   if r.sourceAnsi[0] = #0 then
  1491.   begin
  1492.     FRemovedEntry := true;
  1493.     r.sourceAnsi[0] := AnsiChar(r.sourceUnicode[0]);
  1494.   end;
  1495.  
  1496.   FSourceAnsi := r.sourceAnsi;
  1497.   FSourceUnicode := r.sourceUnicode;
  1498.   FID := IntToStr(r.recordNumber);
  1499.  
  1500.   if r.sourceDrive = 26 then
  1501.     FSourceDrive := '@' // @ is the "Network home drive" of the Win95 time
  1502.   else
  1503.     FSourceDrive := Chr(Ord('A') + r.sourceDrive);
  1504.  
  1505.   FDeletionTime := FileTimeToDateTime(r.deletionTime);
  1506.   FOriginalSize := r.originalSize;
  1507.  
  1508.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1509.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1510.   AnsiRemoveNulChars(FSourceAnsi);
  1511.   UnicodeRemoveNulChars(FSourceUnicode);
  1512. end;
  1513.  
  1514. function TRbInfoWItem.DeleteFile: boolean;
  1515. var
  1516.   r: string;
  1517. begin
  1518.   r := GetPhysicalFile;
  1519.   if DirectoryExists(r) then
  1520.     result := DeleteDirectory(r)
  1521.   else
  1522.     result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung?
  1523.  
  1524.   // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Erstes Byte auf 0 setzen)
  1525. end;
  1526.  
  1527. function TRbInfoWItem.GetPhysicalFile: string;
  1528. begin
  1529.   if FRemovedEntry then
  1530.   begin
  1531.     result := '';
  1532.     Exit;
  1533.   end;
  1534.  
  1535.   (*
  1536.   This is actually a bit tricky...
  1537.   Win95 will choose the first letter of the AnsiSource name.
  1538.   WinNT will choose the first letter of the UnicodeSource name.
  1539.   WinXP will choose the driveNumber member.
  1540.  
  1541.   Windows XP is kinda buggy when it comes to changing a drive letter.
  1542.   For example, the drive E: was changed to K:
  1543.   The drive letter is 04 (E), the Source name begins with E:\ and the physical file is De0.txt .
  1544.   After the recycle bin is opened the first time:
  1545.   - The recycle bin will show the file origin as K:\ and not as E:\
  1546.   - The file was renamed from De0.txt to Dk0.txt
  1547.   - The file can be recovered at this time
  1548.   When the recycle bin is closed, the INFO2 file will not be corrected (which is a bug).
  1549.   So, if you open the recycle bin again, the record will be marked
  1550.   as deleted in the INFO file (the first byte will be set to 0),
  1551.   because Windows searches for De0.txt and doesn't find it.
  1552.  
  1553.   (This comment also applies to TRbInfoAItem.GetPhysicalFile)
  1554.   *)
  1555.  
  1556.   // e.g. C:\...\DC0.doc
  1557.   result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
  1558.             'D' + SourceDrive (* SourceUnicode[1] *) + ID + ExtractFileExt(SourceUnicode);
  1559. end;
  1560.  
  1561. constructor TRbInfoWItem.Create(fs: TStream; AIndexFile: string);
  1562. begin
  1563.   inherited Create;
  1564.   ReadFromStream(fs);
  1565.   FIndexFile := AIndexFile;
  1566. end;
  1567.  
  1568. { TRbVistaItem }
  1569.  
  1570. procedure TRbVistaItem.ReadFromStream(stream: TStream);
  1571. var
  1572.   r1: TRbVistaRecord1;
  1573.   r2: TRbVistaRecord2Head;
  1574.   r2SourceUnicode: array of WideChar;
  1575.   version: int64;
  1576.   i: Integer;
  1577. resourcestring
  1578.   LNG_VISTA_WRONG_FORMAT = 'Invalid Vista index format version %d';
  1579. begin
  1580.   stream.ReadBuffer(version, SizeOf(version));
  1581.  
  1582.   if version = 1 then
  1583.   begin
  1584.     stream.Seek(0, soBeginning);
  1585.     stream.ReadBuffer(r1, SizeOf(r1));
  1586.  
  1587.     (* FSourceAnsi := AnsiString(WideCharArrayToWideString(r1.sourceUnicode)); *)
  1588.     SetLength(FSourceAnsi, Length(r1.sourceUnicode));
  1589.     for i := 0 to Length(r1.sourceUnicode)-1 do
  1590.       FSourceAnsi[i+1] := AnsiChar(r1.sourceUnicode[i]); // Note: Invalid chars are automatically converted into '?'
  1591.  
  1592.     (* FSourceUnicode := WideCharArrayToWideString(r1.sourceUnicode); *)
  1593.     SetLength(FSourceUnicode, Length(r1.sourceUnicode));
  1594.     for i := 0 to Length(r1.sourceUnicode)-1 do
  1595.       FSourceUnicode[i+1] := r1.sourceUnicode[i];
  1596.  
  1597.     FID := ''; // will be added manually (at the constructor)
  1598.     FSourceDrive := Char(r1.sourceUnicode[1]);
  1599.     FDeletionTime := FileTimeToDateTime(r1.deletionTime);
  1600.     FOriginalSize := r1.originalSize;
  1601.   end
  1602.   else if version = 2 then
  1603.   begin
  1604.     stream.Seek(0, soBeginning);
  1605.     stream.ReadBuffer(r2, SizeOf(r2));
  1606.  
  1607.     SetLength(r2SourceUnicode, SizeOf(WideChar)*(r2.SourceCountChars-1));
  1608.     stream.Read(r2SourceUnicode[0], SizeOf(WideChar)*(r2.sourceCountChars-1));
  1609.  
  1610.     // Invalid chars are automatically converted into '?'
  1611.     (* FSourceAnsi := AnsiString(WideCharArrayToWideString(r2sourceUnicode)); *)
  1612.     SetLength(FSourceAnsi, Length(r2sourceUnicode));
  1613.     for i := 0 to Length(r2sourceUnicode)-1 do
  1614.       FSourceAnsi[i+1] := AnsiChar(r2sourceUnicode[i]);
  1615.  
  1616.     (* FSourceUnicode := WideCharArrayToWideString(r2sourceUnicode); *)
  1617.     SetLength(FSourceUnicode, Length(r2sourceUnicode));
  1618.     for i := 0 to Length(r2sourceUnicode)-1 do
  1619.       FSourceUnicode[i+1] := WideChar(r2sourceUnicode[i]);
  1620.  
  1621.     FID := ''; // will be added manually (at the constructor)
  1622.     FSourceDrive := Char(r2sourceUnicode[1]);
  1623.     FDeletionTime := FileTimeToDateTime(r2.deletionTime);
  1624.     FOriginalSize := r2.originalSize;
  1625.   end
  1626.   else
  1627.   begin
  1628.     raise Exception.CreateFmt(LNG_VISTA_WRONG_FORMAT, [version]);
  1629.   end;
  1630.  
  1631.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1632.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1633.   AnsiRemoveNulChars(FSourceAnsi);
  1634.   UnicodeRemoveNulChars(FSourceUnicode);
  1635. end;
  1636.  
  1637. function TRbVistaItem.DeleteFile: boolean;
  1638. var
  1639.   r: string;
  1640. begin
  1641.   r := GetPhysicalFile;
  1642.   if DirectoryExists(r) then
  1643.     result := DeleteDirectory(r)
  1644.   else
  1645.     result := SysUtils.DeleteFile(r);
  1646.  
  1647.   SysUtils.DeleteFile(FIndexFile);
  1648. end;
  1649.  
  1650. function TRbVistaItem.GetPhysicalFile: string;
  1651. begin
  1652.   result := FIndexFile;
  1653.   if Pos('$I', Result) = 0 then
  1654.     result := ''
  1655.   else
  1656.     result := StringReplace(Result, '$I', '$R', [rfIgnoreCase]);
  1657. end;
  1658.  
  1659. constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string);
  1660. begin
  1661.   inherited Create;
  1662.   ReadFromStream(fs);
  1663.   FIndexFile := AIndexFile;
  1664.   FID := AID;
  1665. end;
  1666.  
  1667. { TRecycleBinManager }
  1668.  
  1669. class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean;
  1670. var
  1671.   PSHEmptyRecycleBin: TSHEmptyRecycleBin;
  1672.   LibHandle: THandle;
  1673. begin
  1674.   // Source: http://www.dsdt.info/tipps/?id=176
  1675.   result := true;
  1676.   LibHandle := LoadLibrary(shell32);
  1677.   try
  1678.     if LibHandle <> 0 then
  1679.     begin
  1680.       @PSHEmptyRecycleBin := GetProcAddress(LibHandle, C_SHEmptyRecycleBin);
  1681.       if @PSHEmptyRecycleBin <> nil then
  1682.       begin
  1683.         PSHEmptyRecycleBin(hInstance, nil, flags);
  1684.       end
  1685.       else
  1686.         result := false;
  1687.     end
  1688.     else
  1689.       result := false;
  1690.   finally
  1691.     @PSHEmptyRecycleBin := nil;
  1692.     if LibHandle <> 0 then FreeLibrary(LibHandle);
  1693.   end;
  1694. end;
  1695.  
  1696. class function TRecycleBinManager.EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean;
  1697. const
  1698.   SHERB_NOCONFIRMATION = $00000001;
  1699.   SHERB_NOPROGRESSUI   = $00000002;
  1700.   SHERB_NOSOUND        = $00000004;
  1701. var
  1702.   flags: cardinal;
  1703. begin
  1704.   flags := 0;
  1705.  
  1706.   if not progress then
  1707.     flags := flags or SHERB_NOPROGRESSUI;
  1708.   if not confirmation then
  1709.     flags := flags or SHERB_NOCONFIRMATION;
  1710.   if not sound then
  1711.     flags := flags or SHERB_NOSOUND;
  1712.  
  1713.   result := EmptyOwnRecyclers(flags);
  1714. end;
  1715.  
  1716. class function TRecycleBinManager.GetGlobalMaxPercentUsage: integer;
  1717. var
  1718.   reg: TRegistry;
  1719.   purgeInfo: TRbWin95PurgeInfo;
  1720. const
  1721.   RES_DEFAULT = 10; // Windows 95 - Standardwert
  1722. begin
  1723.   if Win32MajorVersion >= 6 then
  1724.   begin
  1725.     // Only available till Windows XP
  1726.     result := -1;
  1727.     exit;
  1728.   end;
  1729.  
  1730.   result := RES_DEFAULT;
  1731.  
  1732.   reg := TRegistry.Create;
  1733.   try
  1734.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1735.  
  1736.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1737.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1738.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1739.     begin
  1740.       if reg.ValueExists('Percent') then
  1741.       begin
  1742.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1743.  
  1744.         result := reg.ReadInteger('Percent');
  1745.       end
  1746.       else if reg.ValueExists('PurgeInfo') then
  1747.       begin
  1748.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1749.  
  1750.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1751.         result := purgeInfo.percentGlobal;
  1752.       end;
  1753.  
  1754.       reg.CloseKey;
  1755.     end;
  1756.   finally
  1757.     reg.Free;
  1758.   end;
  1759. end;
  1760.  
  1761. class function TRecycleBinManager.GetGlobalNukeOnDelete: boolean;
  1762. var
  1763.   reg: TRegistry;
  1764.   purgeInfo: TRbWin95PurgeInfo;
  1765. const
  1766.   RES_DEFAULT = false; // Windows 95 - Standardwert
  1767. begin
  1768.   if Win32MajorVersion >= 6 then
  1769.   begin
  1770.     // Only available till Windows XP
  1771.     result := false;
  1772.     exit;
  1773.   end;
  1774.  
  1775.   result := RES_DEFAULT;
  1776.  
  1777.   reg := TRegistry.Create;
  1778.   try
  1779.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1780.  
  1781.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1782.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1783.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1784.     begin
  1785.       if reg.ValueExists('NukeOnDelete') then
  1786.       begin
  1787.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1788.  
  1789.         result := reg.ReadBool('NukeOnDelete');
  1790.       end
  1791.       else if reg.ValueExists('PurgeInfo') then
  1792.       begin
  1793.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1794.  
  1795.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1796.         result := (purgeInfo.NukeOnDeleteBits and $8000000) = $8000000; // bit 27
  1797.       end;
  1798.  
  1799.       reg.CloseKey;
  1800.     end;
  1801.   finally
  1802.     reg.Free;
  1803.   end;
  1804. end;
  1805.  
  1806. (* TODO:
  1807. There are more registry values (found in WinXP):
  1808.  
  1809. BitBucket\<driveletter>
  1810.   VolumeSerialNumber
  1811.   IsUnicode
  1812.  
  1813. *)
  1814.  
  1815. class function TRecycleBinManager.UsesGlobalSettings: boolean;
  1816. var
  1817.   reg: TRegistry;
  1818.   purgeInfo: TRbWin95PurgeInfo;
  1819. const
  1820.   RES_DEFAULT = true; // Windows 95 - Standardwert
  1821. begin
  1822.   if Win32MajorVersion >= 6 then
  1823.   begin
  1824.     // Only available till Windows XP
  1825.     result := false;
  1826.     exit;
  1827.   end;
  1828.  
  1829.   result := RES_DEFAULT;
  1830.  
  1831.   reg := TRegistry.Create;
  1832.   try
  1833.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1834.  
  1835.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1836.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1837.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1838.     begin
  1839.       if reg.ValueExists('UseGlobalSettings') then
  1840.       begin
  1841.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1842.  
  1843.         result := reg.ReadBool('UseGlobalSettings');
  1844.       end
  1845.       else if reg.ValueExists('PurgeInfo') then
  1846.       begin
  1847.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1848.  
  1849.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1850.         result := purgeInfo.bGlobalSettings;
  1851.       end;
  1852.  
  1853.       reg.CloseKey;
  1854.     end;
  1855.   finally
  1856.     reg.Free;
  1857.   end;
  1858. end;
  1859.  
  1860. class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive});
  1861. var
  1862.   drive: AnsiChar;
  1863. begin
  1864.   for drive := 'A' to 'Z' do
  1865.     if RecycleBinPossible(drive) then
  1866.       list.Add(TRbDrive.Create(drive));
  1867. end;
  1868.  
  1869. class function TRecycleBinManager.OwnRecyclersEmpty: boolean;
  1870. var
  1871.   drives: TObjectList;
  1872.   i: integer;
  1873. begin
  1874.   result := true;
  1875.  
  1876.   drives := TObjectList.Create(true);
  1877.   try
  1878.     ListDrives(drives);
  1879.     for i := 0 to drives.Count - 1 do
  1880.     begin
  1881.       result := result and TRbDrive(drives.Items[i]).IsEmpty;
  1882.       if not result then break;
  1883.     end;
  1884.   finally
  1885.     drives.Free;
  1886.   end;
  1887. end;
  1888.  
  1889. class function TRecycleBinManager.OwnRecyclersNumItems: int64;
  1890. var
  1891.   drives: TObjectList;
  1892.   i: integer;
  1893. begin
  1894.   result := 0;
  1895.  
  1896.   drives := TObjectList.Create(true);
  1897.   try
  1898.     ListDrives(drives);
  1899.     for i := 0 to drives.Count - 1 do
  1900.     begin
  1901.       result := result + TRbDrive(drives.Items[i]).GetNumItems;
  1902.     end;
  1903.   finally
  1904.     drives.Free;
  1905.   end;
  1906. end;
  1907.  
  1908. class function TRecycleBinManager.OwnRecyclersSize: int64;
  1909. var
  1910.   drives: TObjectList;
  1911.   i: integer;
  1912. begin
  1913.   result := 0;
  1914.  
  1915.   drives := TObjectList.Create(true);
  1916.   try
  1917.     ListDrives(drives);
  1918.     for i := 0 to drives.Count - 1 do
  1919.     begin
  1920.       result := result + TRbDrive(drives.Items[i]).GetSize;
  1921.     end;
  1922.   finally
  1923.     drives.Free;
  1924.   end;
  1925. end;
  1926.  
  1927. class function TRecycleBinManager.RecycleBinPossible(Drive: AnsiChar): boolean;
  1928. var
  1929.   typ: Integer;
  1930. begin
  1931.   // Does the drive exist?
  1932.   // see http://www.delphipraxis.net/post2933.html
  1933.   result := GetLogicalDrives and (1 shl DriveLetterToDriveNumber(Drive)) <> 0;
  1934.   if not result then exit;
  1935.  
  1936.   // Is it a fixed drive? (Only they can have recycle bins)
  1937.   // TODO: is that correct, or can also have other drive types have recyclers?
  1938.   typ := GetDriveType(PChar(Drive + ':\'));
  1939.   result := typ = DRIVE_FIXED;
  1940. end;
  1941.  
  1942. class function TRecycleBinManager.RecyclerGetCurrentIconString: string;
  1943. begin
  1944.   if OwnRecyclersEmpty then
  1945.     result := RecyclerGetEmptyIconString
  1946.   else
  1947.     result := RecyclerGetFullIconString;
  1948. end;
  1949.  
  1950. class function TRecycleBinManager.RecyclerGetDefaultIconString: string;
  1951. var
  1952.   reg: TRegistry;
  1953. begin
  1954.   // Please note: The "default" icon is not always the icon of the
  1955.   // current recycle bin in its current state (full, empty)
  1956.   // At Windows 95b, the registry value actually did change every time the
  1957.   // recycle bin state did change, but at Windows 2000 I could not see any
  1958.   // update, even after reboot. So, the registry value is possible fixed as
  1959.   // default = empty on newer OS versions.
  1960.  
  1961.   reg := TRegistry.Create;
  1962.   try
  1963.     reg.RootKey := HKEY_CLASSES_ROOT;
  1964.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1965.     begin
  1966.       result := reg.ReadString('');
  1967.       reg.CloseKey;
  1968.     end;
  1969.   finally
  1970.     reg.Free;
  1971.   end;
  1972. end;
  1973.  
  1974. class function TRecycleBinManager.RecyclerGetEmptyIconString: string;
  1975. var
  1976.   reg: TRegistry;
  1977. begin
  1978.   reg := TRegistry.Create;
  1979.   try
  1980.     reg.RootKey := HKEY_CLASSES_ROOT;
  1981.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1982.     begin
  1983.       result := reg.ReadString('Empty');
  1984.       reg.CloseKey;
  1985.     end;
  1986.   finally
  1987.     reg.Free;
  1988.   end;
  1989. end;
  1990.  
  1991. class function TRecycleBinManager.RecyclerGetFullIconString: string;
  1992. var
  1993.   reg: TRegistry;
  1994. begin
  1995.   reg := TRegistry.Create;
  1996.   try
  1997.     reg.RootKey := HKEY_CLASSES_ROOT;
  1998.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1999.     begin
  2000.       result := reg.ReadString('Full');
  2001.       reg.CloseKey;
  2002.     end;
  2003.   finally
  2004.     reg.Free;
  2005.   end;
  2006. end;
  2007.  
  2008. class function TRecycleBinManager.RecyclerGetInfoTip: string;
  2009. var
  2010.   reg: TRegistry;
  2011. begin
  2012.   // Not available in some older versions of Windows
  2013.  
  2014.   reg := TRegistry.Create;
  2015.   try
  2016.     reg.RootKey := HKEY_CLASSES_ROOT;
  2017.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then
  2018.     begin
  2019.       result := reg.ReadString('InfoTip');
  2020.       result := DecodeReferenceString(result);
  2021.  
  2022.       reg.CloseKey;
  2023.     end;
  2024.   finally
  2025.     reg.Free;
  2026.   end;
  2027. end;
  2028.  
  2029. class function TRecycleBinManager.RecyclerGetIntroText: string;
  2030. var
  2031.   reg: TRegistry;
  2032. begin
  2033.   // Not available in some older versions of Windows
  2034.  
  2035.   reg := TRegistry.Create;
  2036.   try
  2037.     reg.RootKey := HKEY_CLASSES_ROOT;
  2038.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then
  2039.     begin
  2040.       result := reg.ReadString('IntroText');
  2041.       result := DecodeReferenceString(result);
  2042.  
  2043.       reg.CloseKey;
  2044.     end;
  2045.   finally
  2046.     reg.Free;
  2047.   end;
  2048. end;
  2049.  
  2050. class function TRecycleBinManager.RecyclerGetName: string;
  2051. var
  2052.   reg: TRegistry;
  2053. begin
  2054.   // Windows 95b:
  2055.   // Change of CLSID\{645FF040-5081-101B-9F08-00AA002F954E} will change the desktop name of the recycle bin.
  2056.  
  2057.   // Windows 2000: If LocalizedString is available, the 3rd argument will be parsed
  2058.   // (if the third argument will removed, it will be read out from the DLL resource string automatically)
  2059.  
  2060.   reg := TRegistry.Create;
  2061.   try
  2062.     reg.RootKey := HKEY_CLASSES_ROOT;
  2063.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then
  2064.     begin
  2065.       if reg.ValueExists('LocalizedString') then
  2066.       begin
  2067.         result := reg.ReadString('LocalizedString');
  2068.         result := DecodeReferenceString(result);
  2069.       end
  2070.       else
  2071.       begin
  2072.         result := reg.ReadString('');
  2073.       end;
  2074.  
  2075.       reg.CloseKey;
  2076.     end;
  2077.   finally
  2078.     reg.Free;
  2079.   end;
  2080. end;
  2081.  
  2082. class function TRecycleBinManager.RecyclerEmptyEventGetName: string;
  2083. var
  2084.   reg: TRegistry;
  2085. begin
  2086.   reg := TRegistry.Create;
  2087.   try
  2088.     reg.RootKey := HKEY_CURRENT_USER;
  2089.     if reg.OpenKeyReadOnly('AppEvents\EventLabels\EmptyRecycleBin') then
  2090.     begin
  2091.       result := reg.ReadString('');
  2092.       reg.CloseKey;
  2093.     end;
  2094.   finally
  2095.     reg.Free;
  2096.   end;
  2097. end;
  2098.  
  2099. class function TRecycleBinManager.RecyclerEmptyEventGetCurrentSound: string;
  2100. begin
  2101.   result := RecyclerEmptyEventGetSound('.Current');
  2102. end;
  2103.  
  2104. class function TRecycleBinManager.RecyclerEmptyEventGetDefaultSound: string;
  2105. begin
  2106.   result := RecyclerEmptyEventGetSound('.Default');
  2107. end;
  2108.  
  2109. class procedure TRecycleBinManager.RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
  2110. var
  2111.   reg: TRegistry;
  2112. begin
  2113.   reg := TRegistry.Create;
  2114.   try
  2115.     reg.RootKey := HKEY_CURRENT_USER;
  2116.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2117.     begin
  2118.       reg.GetKeyNames(AStringList);
  2119.       reg.CloseKey;
  2120.     end;
  2121.   finally
  2122.     reg.Free;
  2123.   end;
  2124. end;
  2125.  
  2126. class function TRecycleBinManager.RecyclerEmptyEventGetSound(ACategory: string): string;
  2127. var
  2128.   reg: TRegistry;
  2129. resourcestring
  2130.   LNG_SND_EVENT_CAT_ERROR = 'The category "%s" is not available for the notification event "%s".';
  2131. begin
  2132.   // Outputs an filename or empty string for no sound defined.
  2133.  
  2134.   reg := TRegistry.Create;
  2135.   try
  2136.     reg.RootKey := HKEY_CURRENT_USER;
  2137.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2138.     begin
  2139.       if reg.OpenKeyReadOnly(ACategory) then
  2140.       begin
  2141.         result := reg.ReadString('');
  2142.         reg.CloseKey;
  2143.       end
  2144.       else
  2145.         raise EEventCategoryNotDefined.CreateFmt(LNG_SND_EVENT_CAT_ERROR, [ACategory, 'EmptyRecycleBin']);
  2146.       reg.CloseKey;
  2147.     end;
  2148.   finally
  2149.     reg.Free;
  2150.   end;
  2151. end;
  2152.  
  2153. class function TRecycleBinManager.RecyclerQueryFunctionAvailable: boolean;
  2154. var
  2155.   RBHandle: THandle;
  2156.   SHQueryRecycleBin: TSHQueryRecycleBin;
  2157. begin
  2158.   // Windows 95 without Internet Explorer 4 has no SHQueryRecycleBinA.
  2159.   RBHandle := LoadLibrary(shell32);
  2160.   try
  2161.     if RBHandle <> 0 then
  2162.     begin
  2163.       SHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
  2164.       if not Assigned(@SHQueryRecycleBin) then
  2165.       begin
  2166.         FreeLibrary(RBHandle);
  2167.         RBHandle := 0;
  2168.       end;
  2169.     end;
  2170.  
  2171.     result := RBHandle <> 0;
  2172.   finally
  2173.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2174.   end;
  2175. end;
  2176.  
  2177. class function TRecycleBinManager.RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean;
  2178. var
  2179.   Operation: TSHFileOpStruct;
  2180. begin
  2181.   // Template: http://www.dsdt.info/tipps/?id=116
  2182.   with Operation do
  2183.   begin
  2184.     Wnd := hInstance; // OK?
  2185.     wFunc := FO_DELETE;
  2186.     pFrom := PChar(FileOrFolder + #0);
  2187.     pTo := nil;
  2188.     fFlags := FOF_ALLOWUNDO;
  2189.     if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
  2190.   end;
  2191.   Result := SHFileOperation(Operation) = 0;
  2192. end;
  2193.  
  2194. class function TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
  2195. var
  2196.   reg: TRegistry;
  2197. begin
  2198.   result := gpUndefined;
  2199.  
  2200.   reg := TRegistry.Create;
  2201.   try
  2202.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2203.     // even if gpedit.msc shows "Not configured"!
  2204.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2205.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2206.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2207.     begin
  2208.       if reg.ValueExists('NoRecycleFiles') then
  2209.       begin
  2210.         if reg.ReadBool('NoRecycleFiles') then
  2211.           result := gpEnabled
  2212.         else
  2213.           result := gpDisabled;
  2214.         Exit;
  2215.       end;
  2216.       reg.CloseKey;
  2217.     end;
  2218.     {$ENDIF}
  2219.  
  2220.     reg.RootKey := HKEY_CURRENT_USER;
  2221.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2222.     begin
  2223.       if reg.ValueExists('NoRecycleFiles') then
  2224.       begin
  2225.         if reg.ReadBool('NoRecycleFiles') then
  2226.           result := gpEnabled
  2227.         else
  2228.           result := gpDisabled;
  2229.       end;
  2230.       reg.CloseKey;
  2231.     end;
  2232.   finally
  2233.     reg.Free;
  2234.   end;
  2235. end;
  2236.  
  2237. class function TRecycleBinManager.RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
  2238. var
  2239.   reg: TRegistry;
  2240. begin
  2241.   result := gpUndefined;
  2242.   reg := TRegistry.Create;
  2243.   try
  2244.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2245.     // even if gpedit.msc shows "Not configured"!
  2246.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2247.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2248.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2249.     begin
  2250.       if reg.ValueExists('ConfirmFileDelete') then
  2251.       begin
  2252.         if reg.ReadBool('ConfirmFileDelete') then
  2253.           result := gpEnabled
  2254.         else
  2255.           result := gpDisabled;
  2256.         Exit;
  2257.       end;
  2258.       reg.CloseKey;
  2259.     end;
  2260.     {$ENDIF}
  2261.  
  2262.     reg.RootKey := HKEY_CURRENT_USER;
  2263.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2264.     begin
  2265.       if reg.ValueExists('ConfirmFileDelete') then
  2266.       begin
  2267.         if reg.ReadBool('ConfirmFileDelete') then
  2268.           result := gpEnabled
  2269.         else
  2270.           result := gpDisabled;
  2271.       end;
  2272.       reg.CloseKey;
  2273.     end;
  2274.   finally
  2275.     reg.Free;
  2276.   end;
  2277. end;
  2278.  
  2279. class function TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize: integer;
  2280. var
  2281.   reg: TRegistry;
  2282. begin
  2283.   result := -1;
  2284.   reg := TRegistry.Create;
  2285.   try
  2286.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2287.     // even if gpedit.msc shows "Not configured"!
  2288.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2289.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2290.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2291.     begin
  2292.       if reg.ValueExists('RecycleBinSize') then
  2293.       begin
  2294.         result := reg.ReadInteger('RecycleBinSize');
  2295.         Exit;
  2296.       end;
  2297.       reg.CloseKey;
  2298.     end;
  2299.     {$ENDIF}
  2300.  
  2301.     reg.RootKey := HKEY_CURRENT_USER;
  2302.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2303.     begin
  2304.       if reg.ValueExists('RecycleBinSize') then
  2305.       begin
  2306.         result := reg.ReadInteger('RecycleBinSize');
  2307.       end;
  2308.       reg.CloseKey;
  2309.     end;
  2310.   finally
  2311.     reg.Free;
  2312.   end;
  2313. end;
  2314.  
  2315. class function TRecycleBinManager.RecyclerConfirmationDialogEnabled: boolean;
  2316. var
  2317.   gp: GPOLICYBOOL;
  2318. begin
  2319.   gp := RecyclerGroupPolicyConfirmFileDelete;
  2320.   if gp <> gpUndefined then
  2321.   begin
  2322.     result := gp = gpEnabled;
  2323.   end
  2324.   else
  2325.   begin
  2326.     result := RecyclerShellStateConfirmationDialogEnabled;
  2327.   end;
  2328. end;
  2329.  
  2330. class function TRecycleBinManager.RecyclerShellStateConfirmationDialogEnabled: boolean;
  2331. var
  2332.   lpss: SHELLSTATE;
  2333.   bNoConfirmRecycle: boolean;
  2334.  
  2335.   PSHGetSettings: TSHGetSettings;
  2336.   RBHandle: THandle;
  2337.  
  2338.   reg: TRegistry;
  2339.   rbuf: array[0..255] of byte;
  2340. begin
  2341.   PSHGetSettings := nil;
  2342.   result := false; // Avoid warning message
  2343.  
  2344.   RBHandle := LoadLibrary(shell32);
  2345.   try
  2346.     if RBHandle <> 0 then
  2347.     begin
  2348.       PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings);
  2349.       if not Assigned(@PSHGetSettings) then
  2350.       begin
  2351.         FreeLibrary(RBHandle);
  2352.         RBHandle := 0;
  2353.       end;
  2354.     end;
  2355.  
  2356.     if (RBHandle <> 0) and Assigned(PSHGetSettings) then
  2357.     begin
  2358.       ZeroMemory(@lpss, SizeOf(lpss));
  2359.       PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE);
  2360.       bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle
  2361.  
  2362.       result := not bNoConfirmRecycle;
  2363.     end
  2364.     else
  2365.     begin
  2366.       reg := TRegistry.Create;
  2367.       try
  2368.         // API function call failed. Probably because Windows is too old.
  2369.         // Try to read out from registry.
  2370.         // The 3rd bit of the 5th byte of "ShellState" is the value
  2371.         // of "fNoConfirmRecycle".
  2372.  
  2373.         reg.RootKey := HKEY_CURRENT_USER;
  2374.         if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer') then
  2375.         begin
  2376.           ZeroMemory(@rbuf, SizeOf(rbuf));
  2377.           reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf));
  2378.  
  2379.           // Lese 3tes Bit vom 5ten Byte
  2380.           bNoConfirmRecycle := ((rbuf[4] and 4) = 4);
  2381.           result := not bNoConfirmRecycle;
  2382.  
  2383.           reg.CloseKey;
  2384.         end
  2385.         else
  2386.         begin
  2387.           raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]);
  2388.         end;
  2389.       finally
  2390.         reg.Free;
  2391.       end;
  2392.     end;
  2393.   finally
  2394.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2395.   end;
  2396. end;
  2397.  
  2398. class procedure TRecycleBinManager.RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
  2399. var
  2400.   lpss: SHELLSTATE;
  2401.  
  2402.   PSHGetSetSettings: TSHGetSetSettings;
  2403.   RBHandle: THandle;
  2404.  
  2405.   reg: TRegistry;
  2406.   rbuf: array[0..255] of byte;
  2407.  
  2408.   //dwResult: DWORD;
  2409.   lpdwResult: PDWORD_PTR;
  2410. begin
  2411.   PSHGetSetSettings := nil;
  2412.   lpdwResult := nil;
  2413.  
  2414.   RBHandle := LoadLibrary(shell32);
  2415.   try
  2416.     if RBHandle <> 0 then
  2417.     begin
  2418.       PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
  2419.       if not Assigned(@PSHGetSetSettings) then
  2420.       begin
  2421.         FreeLibrary(RBHandle);
  2422.         RBHandle := 0;
  2423.       end;
  2424.     end;
  2425.  
  2426.     if (RBHandle <> 0) and Assigned(PSHGetSetSettings) then
  2427.     begin
  2428.       ZeroMemory(@lpss, SizeOf(lpss));
  2429.  
  2430.       PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get
  2431.  
  2432.       // Set 3rd bit equal to NewSetting
  2433.       if NewSetting then
  2434.         lpss.Flags1 := lpss.Flags1 or  $00000004
  2435.       else
  2436.         lpss.Flags1 := lpss.Flags1 and $FFFFFFFB;
  2437.  
  2438.       PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
  2439.  
  2440.       SendMessageTimeout (
  2441.         HWND_BROADCAST, WM_SETTINGCHANGE,
  2442.         0, lParam (pChar ('ShellState')),
  2443.         SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2444.       );
  2445.     end
  2446.     else
  2447.     begin
  2448.       reg := TRegistry.Create;
  2449.       try
  2450.         // API function call failed. Probably because Windows is too old.
  2451.         // Try to read out from registry.
  2452.         // The 3rd bit of the 5th byte of "ShellState" is the value
  2453.         // of "fNoConfirmRecycle".
  2454.  
  2455.         reg.RootKey := HKEY_CURRENT_USER;
  2456.         if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false) then
  2457.         begin
  2458.           ZeroMemory(@rbuf, SizeOf(rbuf));
  2459.  
  2460.           reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get
  2461.  
  2462.           // Set 3rd bit equal to NewSetting
  2463.           if NewSetting then
  2464.             rbuf[4] := rbuf[4] or  $04
  2465.           else
  2466.             rbuf[4] := rbuf[4] and $FB;
  2467.  
  2468.           reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
  2469.  
  2470.           SendMessageTimeout (
  2471.             HWND_BROADCAST, WM_SETTINGCHANGE,
  2472.             0, lParam (pChar ('ShellState')),
  2473.             SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2474.           );
  2475.  
  2476.           reg.CloseKey;
  2477.         end
  2478.         else
  2479.         begin
  2480.           raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSetSettings])]);
  2481.         end;
  2482.       finally
  2483.         reg.Free;
  2484.       end;
  2485.     end;
  2486.   finally
  2487.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2488.   end;
  2489. end;
  2490.  
  2491. { TRbRecycleBinItem }
  2492.  
  2493. function TRbRecycleBinItem.GetSource: string;
  2494. begin
  2495.   {$IFDEF UNICODE}
  2496.   result := SourceUnicode;
  2497.   {$ELSE}
  2498.   result := SourceAnsi;
  2499.   {$ENDIF}
  2500. end;
  2501.  
  2502. end.
  2503.