Subversion Repositories recyclebinunit

Rev

Rev 90 | Rev 95 | 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: 30 JUN 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-06-30';
  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. function WideCharArrayToWideString(x: array of WideChar): WideString;
  384. var
  385.   i: integer;
  386. begin
  387.   // In x86, the "cast" works with WideString.
  388.   // In x64, it does not work (outputs empty string, without compiler warning!)
  389.   // So, we created this fake-cast
  390.   SetLength(result, Length(x));
  391.   for i := 0 to Length(x)-1 do
  392.     result[i+1] := x[i];
  393. end;
  394.  
  395. function AnsiCharArrayToWideString(x: array of AnsiChar): WideString;
  396. var
  397.   i: integer;
  398. begin
  399.   SetLength(result, Length(x));
  400.   for i := 0 to Length(x)-1 do
  401.     result[i+1] := WideChar(x[i]);
  402. end;
  403.  
  404. procedure AnsiRemoveNulChars(var s: AnsiString);
  405. begin
  406.   while (Length(s) > 0) and (s[Length(s)] = #0) do
  407.     s := Copy(s, 1, Length(s)-1);
  408. end;
  409.  
  410. procedure UnicodeRemoveNulChars(var s: WideString);
  411. begin
  412.   while (Length(s) > 0) and (s[Length(s)] = #0) do
  413.     s := Copy(s, 1, Length(s)-1);
  414. end;
  415.  
  416. function GetDriveGUID(driveLetter: AnsiChar; var guid: TGUID): DWORD;
  417. var
  418.   Buffer: array[0..50] of Char;
  419.   x: string;
  420.   PGetVolumeNameForVolumeMountPoint: TGetVolumeNameForVolumeMountPoint;
  421.   RBHandle: THandle;
  422. begin
  423.   RBHandle := LoadLibrary(kernel32);
  424.   try
  425.     if RBHandle <> 0 then
  426.     begin
  427.       PGetVolumeNameForVolumeMountPoint := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);
  428.       if not Assigned(@PGetVolumeNameForVolumeMountPoint) then
  429.       begin
  430.         result := GetLastError;
  431.         FreeLibrary(RBHandle);
  432.         RBHandle := 0;
  433.       end
  434.       else
  435.       begin
  436.         if PGetVolumeNameForVolumeMountPoint(PChar(driveLetter+':\'), Buffer, SizeOf(Buffer)) then
  437.         begin
  438.           x := string(buffer);
  439.           x := copy(x, 11, 38);
  440.           guid := StringToGUID(x);
  441.           result := ERROR_SUCCESS;
  442.         end
  443.         else
  444.           result := GetLastError;
  445.       end;
  446.     end
  447.     else result := GetLastError;
  448.   finally
  449.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  450.   end;
  451. end;
  452.  
  453. function FileTimeToDateTime(FileTime: FILETIME): TDateTime;
  454. {$IFDEF FILETIME_DELPHI_CODE}
  455. var
  456.   SystemTime: TSystemTime;
  457.   nowUTC: TDateTime;
  458.   gmtDifference: int64;
  459. begin
  460.   GetSystemTime(SystemTime);
  461.   with SystemTime do
  462.   begin
  463.     // http://www.delphipraxis.net/post340194.html#34019
  464.     nowUTC := EncodeDate(wYear, wMonth, wDay) +
  465.               EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
  466.   end;
  467.  
  468.   gmtDifference := datetimetounix(nowUTC) - datetimetounix(Now);
  469.  
  470.   // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf states:
  471.   // UnixTime = 0.0000001 * NTTime + 11644473600
  472.   // This is wrong! The correct formula is:
  473.   // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600
  474.   // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)
  475.   result := unixtodatetime(round(0.0000001 * int64(FileTime)) - 11644473600 - gmtDifference);
  476. {$ELSE}
  477. var
  478.   LocalTime: TFileTime;
  479.   DOSTime: Integer;
  480. begin
  481.   FileTimeToLocalFileTime(FileTime, LocalTime);
  482.   FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo);
  483.   Result := FileDateToDateTime(DOSTime);
  484. {$ENDIF}
  485. end;
  486.  
  487. function DeleteDirectory(const Name: string): boolean;
  488. var
  489.   F: TSearchRec;
  490. begin
  491.   result := true;
  492.   if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then
  493.   begin
  494.     try
  495.       repeat
  496.         if F.Attr and faDirectory <> 0 then
  497.         begin
  498.           if (F.Name <> '.') and (F.Name <> '..') then
  499.           begin
  500.             result := result and DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);
  501.           end;
  502.         end
  503.         else
  504.         begin
  505.           if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;
  506.         end;
  507.       until FindNext(F) <> 0;
  508.     finally
  509.       FindClose(F);
  510.     end;
  511.     if not RemoveDir(Name) then result := false;
  512.   end;
  513. end;
  514.  
  515. function DriveLetterToDriveNumber(driveLetter: AnsiChar): integer;
  516. var
  517.   tmp: string;
  518. begin
  519.   tmp := LowerCase(string(driveLetter));
  520.   result := Ord(tmp[1])-Ord('a');
  521. end;
  522.  
  523. function GetStringFromDLL(filename: string; num: integer): string;
  524. const
  525.   // Source: http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp
  526.   MAX_BUF = 4097; // OK?
  527. var
  528.   hLib: THandle;
  529.   buf: array[0..MAX_BUF] of char;
  530. begin
  531.   hLib := LoadLibrary(PChar(filename));
  532.   try
  533.     LoadString(hLib, num, buf, sizeof(buf));
  534.     result := buf;
  535.   finally
  536.     FreeLibrary(hLib);
  537.   end;
  538. end;
  539.  
  540. function ExpandEnvStr(const szInput: string): string;
  541. const
  542.   MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
  543. begin
  544.   // Source: http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html
  545.   SetLength(Result,MAXSIZE);
  546.   SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
  547.     @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
  548. end;
  549.  
  550. function DecodeReferenceString(s: string): string;
  551. var
  552.   dll, id, lang, cache: string;
  553.   sl, sl2: tstringlist;
  554. begin
  555.   // Beispiele
  556.   // Papierkorb                                                 -- Windows 95
  557.   // @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000
  558.  
  559.   if Copy(s, 1, 1) = '@' then
  560.   begin
  561.     // Referenz auf eine DLL
  562.     // @<dll>,-<id>[@<lang>][,<cache>]
  563.  
  564.     sl := TStringList.Create;
  565.     try
  566.       // '@' am Anfang entfernen
  567.       s := Copy(s, 2, length(s)-1);
  568.  
  569.       // Nach ',' auftrennen
  570.       // sl[0] --> dll
  571.       // sl[1] --> -id@lang
  572.       // sl[2] --> cache
  573.       sl.CommaText := s;
  574.  
  575.       if sl.Count > 2 then
  576.       begin
  577.         // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden
  578.         // Ist bei Windows 2000 der Fall
  579.         cache := sl[2];
  580.         result := cache;
  581.         exit;
  582.       end;
  583.  
  584.       if sl.Count > 1 then
  585.       begin
  586.         dll := sl[0];
  587.  
  588.         sl2 := TStringList.Create;
  589.         try
  590.           // Nach '@' auftrennen
  591.           // sl2[0] --> id
  592.           // sl2[1] --> lang
  593.           sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);
  594.  
  595.           id := sl2[0];
  596.  
  597.           if sl2.Count > 1 then
  598.           begin
  599.             // ToDo: In Zukunft beachten, sofern möglich
  600.             lang := sl2[1];
  601.           end;
  602.  
  603.           // Umgebungsvariablen erkennen und Minuszeichen entfernen
  604.           result := GetStringFromDLL(ExpandEnvStr(dll), -StrToInt(id));
  605.         finally
  606.           sl2.Free;
  607.         end;
  608.       end
  609.       else
  610.       begin
  611.         // Zu wenige Informationen!
  612.  
  613.         result := '';
  614.       end;
  615.     finally
  616.       sl.Free;
  617.     end;
  618.   end
  619.   else
  620.   begin
  621.     // Kein Hinweis auf eine Referenz
  622.     result := s;
  623.   end;
  624. end;
  625.  
  626. function GPBoolToString(value: GPOLICYBOOL): string;
  627. begin
  628.   case value of
  629.     gpUndefined: result := 'Not configured';
  630.     gpEnabled: result := 'Enabled';
  631.     gpDisabled: result := 'Disabled';
  632.   end;
  633. end;
  634.  
  635. { TRbRecycleBin }
  636.  
  637. constructor TRbRecycleBin.Create(AFileOrDirectory: string; ASID: string='');
  638. begin
  639.   inherited Create;
  640.  
  641.   FFileOrDirectory := AFileOrDirectory;
  642.   FSID := ASID;
  643.   TolerantReading := true;
  644. end;
  645.  
  646. // TODO: also a function that tests if the data files are still existing
  647. function TRbRecycleBin.CheckIndexes(slErrors: TStrings): boolean;
  648.  
  649.   procedure _Assert(assertion: boolean; msg: string; args: array of const);
  650.   begin
  651.     if not assertion then
  652.     begin
  653.       slErrors.Add(Format(msg, args));
  654.       result := false;
  655.     end;
  656.   end;
  657.  
  658.   procedure _HandleIndexFile(AFile: string);
  659.   var
  660.     fs: TFileStream;
  661.     infoHdr: TRbInfoHeader;
  662.   resourcestring
  663.     LNG_IDXERR_VISTA_FILESIZE = '%s: Vista index file has wrong size';
  664.     LNG_IDXERR_INFO_RECSIZE_UNEXPECTED = '%s: record size unexpected';
  665.     LNG_IDXERR_INFO_UNEXPECTED_EOF = '%s: file size wrong';
  666.   begin
  667.     fs := TFileStream.Create(AFile, fmOpenRead);
  668.     try
  669.       fs.Seek(0, soFromBeginning);
  670.  
  671.       if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then
  672.       begin
  673.         _Assert(fs.Size = SizeOf(TRbVistaItem), LNG_IDXERR_VISTA_FILESIZE, [AFile]);
  674.       end
  675.       else if SameText(ExtractFileName(AFile), 'INFO') or
  676.               SameText(ExtractFileName(AFile), 'INFO2') then
  677.       begin
  678.         fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  679.         _Assert((infoHdr.recordLength = SizeOf(TRbInfoRecordA)) or
  680.                 (infoHdr.recordLength = SizeOf(TRbInfoRecordW)), LNG_IDXERR_INFO_RECSIZE_UNEXPECTED, [AFile]);
  681.         _Assert((fs.Size-fs.Position) mod infoHdr.recordLength = 0, LNG_IDXERR_INFO_UNEXPECTED_EOF, [AFile]);
  682.         // TODO: we can also check infoHdr.totalSize or infoHdr.totalEntries
  683.       end
  684.       else Assert(false);
  685.  
  686.       // TODO: we could check each item for invalid stuff...?
  687.     finally
  688.       FreeAndNil(fs);
  689.     end;
  690.   end;
  691.  
  692.   procedure _HandleVistaDir(ADirectory: string);
  693.   var
  694.     SR: TSearchRec;
  695.   begin
  696.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  697.  
  698.     if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
  699.     begin
  700.       repeat
  701.         _HandleIndexFile(ADirectory+sr.Name);
  702.       until FindNext(SR) <> 0;
  703.     end;
  704.     FindClose(SR);
  705.   end;
  706.  
  707. begin
  708.   result := true;
  709.  
  710.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  711.   begin
  712.     _HandleVistaDir(FFileOrDirectory);
  713.  
  714.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  715.     begin
  716.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  717.     end;
  718.  
  719.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  720.     begin
  721.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  722.     end;
  723.   end
  724.   else if FileExists(FFileOrDirectory) then
  725.   begin
  726.     _HandleIndexFile(FFileOrDirectory);
  727.   end
  728.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  729. end;
  730.  
  731. function TRbRecycleBin.GetItem(id: string): TRbRecycleBinItem;
  732.  
  733.   procedure _HandleIndexFile(AFile: string);
  734.   var
  735.     fs: TFileStream;
  736.     infoHdr: TRbInfoHeader;
  737.     testItem: TRbRecycleBinItem;
  738.   begin
  739.     fs := TFileStream.Create(AFile, fmOpenRead);
  740.     try
  741.       fs.Seek(0, soFromBeginning);
  742.  
  743.       if SameText(ExtractFileName(AFile), '$I'+id) then
  744.       begin
  745.         result := TRbVistaItem.Create(fs, AFile, id);
  746.       end
  747.       else
  748.       begin
  749.         fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  750.         case infoHdr.recordLength of
  751.           SizeOf(TRbInfoRecordA):
  752.           begin
  753.             while fs.Position < fs.size do
  754.             begin
  755.               testItem := TRbInfoAItem.Create(fs, AFile);
  756.               if testItem.ID = id then
  757.               begin
  758.                 result := testItem;
  759.                 break;
  760.               end;
  761.             end;
  762.           end;
  763.           SizeOf(TRbInfoRecordW):
  764.           begin
  765.             while fs.Position < fs.size do
  766.             begin
  767.               testItem := TRbInfoWItem.Create(fs, AFile);
  768.               if testItem.ID = id then
  769.               begin
  770.                 result := testItem;
  771.                 break;
  772.               end;
  773.             end;
  774.           end
  775.           else
  776.           begin
  777.             raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]);
  778.           end;
  779.         end;
  780.       end;
  781.     finally
  782.       FreeAndNil(fs);
  783.     end;
  784.   end;
  785.  
  786.   procedure _HandleVistaDir(ADirectory: string);
  787.   var
  788.     SR: TSearchRec;
  789.     fs: TFileStream;
  790.     id: string;
  791.   begin
  792.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  793.  
  794.     if FileExists(ADirectory + '$I' + id) then
  795.     begin
  796.       fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);
  797.       try
  798.         fs.Seek(0, soFromBeginning);
  799.         result := TRbVistaItem.Create(fs, ADirectory+sr.Name, id);
  800.       finally
  801.         FreeAndNil(fs);
  802.       end;
  803.     end;
  804.   end;
  805.  
  806. begin
  807.   result := nil;
  808.  
  809.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  810.   begin
  811.     _HandleVistaDir(FFileOrDirectory);
  812.     if Assigned(result) then exit;
  813.  
  814.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  815.     begin
  816.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  817.       if Assigned(result) then exit;
  818.     end;
  819.  
  820.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  821.     begin
  822.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  823.       if Assigned(result) then exit;
  824.     end;
  825.   end
  826.   else if FileExists(FFileOrDirectory) then
  827.   begin
  828.     _HandleIndexFile(FFileOrDirectory);
  829.     if Assigned(result) then exit;
  830.   end
  831.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  832. end;
  833.  
  834. procedure TRbRecycleBin.ListItems(list: TObjectList{TRbRecycleBinItem});
  835.  
  836.   procedure _HandleIndexFile(AFile: string);
  837.   var
  838.     fs: TFileStream;
  839.     infoHdr: TRbInfoHeader;
  840.     testID: string;
  841.     wTest: TRbInfoWItem;
  842.     bakPosition: int64;
  843.   begin
  844.     fs := TFileStream.Create(AFile, fmOpenRead);
  845.     try
  846.       fs.Seek(0, soFromBeginning);
  847.  
  848.       if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then
  849.       begin
  850.         testID := copy(testID, 3, Length(testID)-2);
  851.         list.Add(TRbVistaItem.Create(fs, AFile, testID));
  852.       end
  853.       else
  854.       begin
  855.         if TolerantReading then
  856.         begin
  857.           // This is a special treatment how to recover data from an INFO/INFO2 file
  858.           // which was corrupted by an incompatible multiboot configuration.
  859.           // Example:
  860.           // - Win95 without IE4 and WinNT4 both write into the INFO file. But Win95 appends the ANSI record and WinNT appends an Unicode record.
  861.           // - 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.
  862.           fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  863.           while fs.Position < fs.size do
  864.           begin
  865.             // Can we actually read a Unicode record?
  866.             if fs.Position + SizeOf(TRbInfoRecordW) <= fs.Size then
  867.             begin
  868.               // Try to read the Unicode record and check if it is valid
  869.               // In case it is no Unicode record, then the Unicode part will be the
  870.               // ANSI source name of the next record. In this case, we won't get
  871.               // a ':' at the Unicode string.
  872.               bakPosition := fs.Position;
  873.               wTest := TRbInfoWItem.Create(fs, AFile);
  874.               if Copy(wTest.SourceUnicode, 2, 1) = ':' then
  875.               begin
  876.                 // Yes, it is a valid Unicode record.
  877.                 list.Add(wTest);
  878.               end
  879.               else
  880.               begin
  881.                 // No, it is not a valid Unicode record. Jump back, and we need
  882.                 // to assume that the following record will be a valid ANSI record.
  883.                 fs.Position := bakPosition;
  884.                 list.Add(TRbInfoAItem.Create(fs, AFile));
  885.               end;
  886.             end
  887.             else
  888.             begin
  889.               // No, there is not enough space left for an Unicode record.
  890.               // So we assume that the following record will be a valid ANSI record.
  891.               list.Add(TRbInfoAItem.Create(fs, AFile));
  892.             end;
  893.           end;
  894.         end
  895.         else
  896.         begin
  897.           // This is the code for non-tolerant reading of the records.
  898.           fs.ReadBuffer(infoHdr, SizeOf(infoHdr));
  899.           case infoHdr.recordLength of
  900.             SizeOf(TRbInfoRecordA):
  901.             begin
  902.               while fs.Position < fs.size do
  903.               begin
  904.                 list.Add(TRbInfoAItem.Create(fs, AFile));
  905.               end;
  906.             end;
  907.             SizeOf(TRbInfoRecordW):
  908.             begin
  909.               while fs.Position < fs.size do
  910.               begin
  911.                 list.Add(TRbInfoWItem.Create(fs, AFile));
  912.               end;
  913.             end
  914.             else
  915.             begin
  916.               raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]);
  917.             end;
  918.           end;
  919.         end;
  920.       end;
  921.     finally
  922.       FreeAndNil(fs);
  923.     end;
  924.   end;
  925.  
  926.   procedure _HandleVistaDir(ADirectory: string);
  927.   var
  928.     SR: TSearchRec;
  929.     fs: TFileStream;
  930.     id: string;
  931.   begin
  932.     ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  933.  
  934.     if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
  935.     begin
  936.       repeat
  937.         id := sr.Name;
  938.         { 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
  939.         id := Copy(id, 3, Length(id)-2);
  940.  
  941.         fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);
  942.         try
  943.           fs.Seek(0, soFromBeginning);
  944.           list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id));
  945.         finally
  946.           FreeAndNil(fs);
  947.         end;
  948.       until FindNext(SR) <> 0;
  949.     end;
  950.     FindClose(SR);
  951.   end;
  952.  
  953. begin
  954.   if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2
  955.   begin
  956.     _HandleVistaDir(FFileOrDirectory);
  957.  
  958.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then
  959.     begin
  960.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');
  961.     end;
  962.  
  963.     if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then
  964.     begin
  965.       _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');
  966.     end;
  967.   end
  968.   else if FileExists(FFileOrDirectory) then
  969.   begin
  970.     _HandleIndexFile(FFileOrDirectory); // Either INFO, or INFO2, or a single Vista index file
  971.   end
  972.   else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);
  973. end;
  974.  
  975. { TRbDrive }
  976.  
  977. procedure TRbDrive.CheckDriveExisting;
  978. begin
  979.   // Does the drive exist?
  980.   // see http://www.delphipraxis.net/post2933.html
  981.   if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then
  982.   begin
  983.     raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(string(FDriveLetter))+':']);
  984.   end;
  985. end;
  986.  
  987. constructor TRbDrive.Create(ADriveLetter: AnsiChar);
  988. begin
  989.   inherited Create;
  990.  
  991.   FDriveLetter := ADriveLetter;
  992.   CheckDriveExisting;
  993. end;
  994.  
  995. function TRbDrive.DiskSize: integer;
  996. begin
  997.   result := SysUtils.DiskSize(DriveNumber+1 {0 is current, 1 is A}) div (1024*1024);
  998. end;
  999.  
  1000. function TRbDrive.DriveNumber: integer;
  1001. begin
  1002.   result := DriveLetterToDriveNumber(FDriveLetter);
  1003. end;
  1004.  
  1005. function TRbDrive.GetAPIInfo: TSHQueryRBInfo;
  1006. var
  1007.   PSHQueryRecycleBin: TSHQueryRecycleBin;
  1008.   RBHandle: THandle;
  1009.   res: HRESULT;
  1010.   Path: string;
  1011. begin
  1012.   Path := FDriveLetter + ':\';
  1013.  
  1014.   // Ref: http://www.delphipraxis.net/post1291.html
  1015.  
  1016.   RBHandle := LoadLibrary(shell32);
  1017.   try
  1018.     PSHQueryRecycleBin := nil;
  1019.     if RBHandle <> 0 then
  1020.     begin
  1021.       PSHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
  1022.       if not Assigned(@PSHQueryRecycleBin) then
  1023.       begin
  1024.         FreeLibrary(RBHandle);
  1025.         RBHandle := 0;
  1026.       end;
  1027.     end;
  1028.  
  1029.     FillChar(result, SizeOf(TSHQueryRBInfo), 0);
  1030.     result.cbSize := SizeOf(TSHQueryRBInfo);
  1031.  
  1032.     if (RBHandle <> 0) and Assigned(PSHQueryRecycleBin) then
  1033.     begin
  1034.       res := PSHQueryRecycleBin(PChar(Path), result);
  1035.       // if Succeeded(res) then
  1036.       if res = S_OK then
  1037.       begin
  1038.         // Alles OK, unser result hat nun die gewünschten Daten.
  1039.       end
  1040.       else
  1041.       begin
  1042.         // Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)
  1043.         // if Path is a floppy or CD drive...
  1044.         raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);
  1045.       end;
  1046.     end
  1047.     else
  1048.       raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);
  1049.   finally
  1050.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  1051.   end;
  1052. end;
  1053.  
  1054. function TRbDrive.GetMaxPercentUsage: Extended;
  1055. var
  1056.   abs: integer; // in MB
  1057.   rel: integer; // in % (0-100)
  1058.   gpSetting: integer;
  1059. const
  1060.   DEFAULT_PERCENT = 10; // Windows 95 default
  1061. begin
  1062.   gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
  1063.   if gpSetting <> -1 then
  1064.     result := gpSetting / 100
  1065.   else if TRecycleBinManager.UsesGlobalSettings then
  1066.     result := TRecycleBinManager.GetGlobalMaxPercentUsage / 100
  1067.   else if OldCapacityPercent(rel) then
  1068.   begin
  1069.     result := rel / 100;
  1070.   end
  1071.   else if NewCapacityAbsolute(abs) then
  1072.   begin
  1073.     result := abs / DiskSize;
  1074.   end
  1075.   else
  1076.   begin
  1077.     result := DEFAULT_PERCENT / 100;
  1078.   end;
  1079. end;
  1080.  
  1081. function TRbDrive.GetMaxAbsoluteUsage: integer;
  1082. var
  1083.   abs: integer; // in MB
  1084.   rel: integer; // in % (0-100)
  1085.   gpSetting: integer;
  1086. const
  1087.   DEFAULT_PERCENT = 10; // Windows 95 default
  1088. begin
  1089.   gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
  1090.   if gpSetting <> -1 then
  1091.     result := Ceil(gpSetting/100 * DiskSize)
  1092.   else if TRecycleBinManager.UsesGlobalSettings then
  1093.     result := Ceil(TRecycleBinManager.GetGlobalMaxPercentUsage/100 * DiskSize)
  1094.   else if NewCapacityAbsolute(abs) then
  1095.   begin
  1096.     result := abs;
  1097.   end
  1098.   else if OldCapacityPercent(rel) then
  1099.   begin
  1100.     result := Ceil(rel/100 * DiskSize);
  1101.   end
  1102.   else
  1103.   begin
  1104.     result := Ceil(DEFAULT_PERCENT/100 * DiskSize);
  1105.   end;
  1106. end;
  1107.  
  1108. function TRbDrive.OldCapacityPercent(var res: integer): boolean;
  1109. var
  1110.   reg: TRegistry;
  1111.   purgeInfo: TRbWin95PurgeInfo;
  1112. begin
  1113.   if Win32MajorVersion >= 6 then
  1114.   begin
  1115.     // Only available till Windows XP
  1116.     result := false;
  1117.     exit;
  1118.   end;
  1119.  
  1120.   result := false;
  1121.  
  1122.   reg := TRegistry.Create;
  1123.   try
  1124.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1125.  
  1126.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1127.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1128.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1129.     begin
  1130.       if reg.OpenKeyReadOnly(string(FDriveLetter)) then
  1131.       begin
  1132.         if reg.ValueExists('Percent') then
  1133.         begin
  1134.           // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1135.  
  1136.           res := reg.ReadInteger('Percent');
  1137.           result := true;
  1138.         end;
  1139.       end
  1140.       else
  1141.       begin
  1142.         if reg.ValueExists('PurgeInfo') then
  1143.         begin
  1144.           // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1145.  
  1146.           reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1147.  
  1148.           res := purgeInfo.percentDrive[FDriveLetter];
  1149.           result := true;
  1150.         end;
  1151.       end;
  1152.  
  1153.       reg.CloseKey;
  1154.     end;
  1155.   finally
  1156.     reg.Free;
  1157.   end;
  1158. end;
  1159.  
  1160. function TRbDrive.NewCapacityAbsolute(var res: integer): boolean;
  1161. var
  1162.   reg: TRegistry;
  1163. begin
  1164.   if Win32MajorVersion < 6 then
  1165.   begin
  1166.     // Only available since Windows Vista
  1167.     result := false;
  1168.     exit;
  1169.   end;
  1170.  
  1171.   result := false;
  1172.  
  1173.   reg := TRegistry.Create;
  1174.   try
  1175.     reg.RootKey := HKEY_CURRENT_USER;
  1176.  
  1177.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
  1178.     begin
  1179.       // Windows Vista and upwards
  1180.       if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
  1181.       begin
  1182.         res := reg.ReadInteger('MaxCapacity'); // in MB
  1183.         result := true;
  1184.       end;
  1185.       reg.CloseKey;
  1186.     end;
  1187.   finally
  1188.     reg.Free;
  1189.   end;
  1190. end;
  1191.  
  1192. function TRbDrive.GetNukeOnDelete: boolean;
  1193. var
  1194.   reg: TRegistry;
  1195.   purgeInfo: TRbWin95PurgeInfo;
  1196. const
  1197.   RES_DEFAULT = false; // Windows 95 default
  1198. begin
  1199.   if TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
  1200.     result := true
  1201.   else if TRecycleBinManager.UsesGlobalSettings then
  1202.     result := TRecycleBinManager.GetGlobalNukeOnDelete
  1203.   else
  1204.   begin
  1205.     result := RES_DEFAULT;
  1206.  
  1207.     reg := TRegistry.Create;
  1208.     try
  1209.       reg.RootKey := HKEY_CURRENT_USER;
  1210.  
  1211.       if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
  1212.       begin
  1213.         // Windows Vista and upwards
  1214.         if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
  1215.         begin
  1216.           result := reg.ReadBool('NukeOnDelete');
  1217.         end;
  1218.         reg.CloseKey;
  1219.       end
  1220.       else
  1221.       begin
  1222.         reg.RootKey := HKEY_LOCAL_MACHINE;
  1223.  
  1224.         // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1225.         // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1226.         if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1227.         begin
  1228.           if reg.OpenKeyReadOnly(string(FDriveLetter)) then
  1229.           begin
  1230.             if reg.ValueExists('NukeOnDelete') then
  1231.             begin
  1232.               // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1233.  
  1234.               result := reg.ReadBool('NukeOnDelete');
  1235.             end;
  1236.           end
  1237.           else
  1238.           begin
  1239.             if reg.ValueExists('PurgeInfo') then
  1240.             begin
  1241.               // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1242.  
  1243.               reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1244.  
  1245.               result := ((purgeInfo.NukeOnDeleteBits shr DriveNumber) and 1) = 1;
  1246.             end;
  1247.           end;
  1248.  
  1249.           reg.CloseKey;
  1250.         end;
  1251.       end;
  1252.     finally
  1253.       reg.Free;
  1254.     end;
  1255.   end;
  1256. end;
  1257.  
  1258. function TRbDrive.GetNumItems: int64;
  1259. begin
  1260.   result := GetAPIInfo.i64NumItems;
  1261. end;
  1262.  
  1263. function TRbDrive.GetSize: int64;
  1264. begin
  1265.   result := GetAPIInfo.i64Size;
  1266. end;
  1267.  
  1268. function TRbDrive.GetVolumeGUID: TGUID;
  1269. begin
  1270.   if GetDriveGUID(FDriveLetter, result) <> ERROR_SUCCESS then
  1271.   begin
  1272.     result := NULL_GUID;
  1273.   end;
  1274. end;
  1275.  
  1276. function TRbDrive.GetVolumeGUIDAvailable: boolean;
  1277. begin
  1278.   result := not IsEqualGUID(VolumeGUID, NULL_GUID);
  1279. end;
  1280.  
  1281. function TRbDrive.IsEmpty: boolean;
  1282. begin
  1283.   result := GetNumItems = 0;
  1284. end;
  1285.  
  1286. function TRbDrive.IsFAT: boolean;
  1287. var
  1288.   Dummy2: DWORD;
  1289.   Dummy3: DWORD;
  1290.   FileSystem: array[0..MAX_PATH] of char;
  1291.   VolumeName: array[0..MAX_PATH] of char;
  1292.   s: string;
  1293. begin
  1294.   s := FDriveLetter + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll
  1295.   GetVolumeInformation(PChar(s), VolumeName,
  1296.     SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem));
  1297.   result := uppercase(copy(FileSystem, 0, 3)) = 'FAT';
  1298. end;
  1299.  
  1300. procedure TRbDrive.ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');
  1301.  
  1302.   procedure _AddSIDFolders(dir: string; wholeFolder: boolean);
  1303.   var
  1304.     SR: TSearchRec;
  1305.   begin
  1306.     dir := IncludeTrailingPathDelimiter(dir);
  1307.     if FindFirst(dir+'S-*', faAnyFile, SR) = 0 then
  1308.     begin
  1309.       try
  1310.         repeat
  1311.           if (SR.Name = '.') or (SR.Name = '..') or not DirectoryExists(dir + SR.Name) then continue;
  1312.  
  1313.           if wholeFolder then
  1314.           begin
  1315.             // Vista
  1316.             list.Add(TRbRecycleBin.Create(dir+SR.Name, SR.Name));
  1317.           end
  1318.           else
  1319.           begin
  1320.             // Win95 .. WinXP
  1321.             if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2') then
  1322.               list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2', SR.Name));
  1323.             if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO') then
  1324.               list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO', SR.Name));
  1325.           end;
  1326.         until FindNext(SR) <> 0;
  1327.       finally
  1328.         FindClose(SR);
  1329.       end;
  1330.     end;
  1331.   end;
  1332.  
  1333. var
  1334.   dir: string;
  1335. begin
  1336.   // Find recyclers from Windows Vista or higher
  1337.  
  1338.   if IsFAT then
  1339.   begin
  1340.     dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim;
  1341.     if DirectoryExists(dir) then
  1342.     begin
  1343.       list.Add(TRbRecycleBin.Create(dir));
  1344.     end;
  1345.   end
  1346.   else
  1347.   begin
  1348.     if UserSID <> '' then
  1349.     begin
  1350.       dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim + UserSID + PathDelim;
  1351.       if DirectoryExists(dir) then
  1352.       begin
  1353.         list.Add(TRbRecycleBin.Create(dir, UserSID));
  1354.       end;
  1355.     end
  1356.     else
  1357.     begin
  1358.       _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + '$recycle.bin', true);
  1359.     end;
  1360.   end;
  1361.  
  1362.   // Find recyclers from Windows before Vista
  1363.  
  1364.   if IsFAT then
  1365.   begin
  1366.     dir := FDriveLetter + DriveDelim + PathDelim + 'Recycled' + PathDelim;
  1367.  
  1368.     // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them)
  1369.     if FileExists(dir + 'INFO2') then
  1370.       list.Add(TRbRecycleBin.Create(dir + 'INFO2')); // Windows 95 with Internet Explorer 4 Extension or higher Windows 9x versions
  1371.     if FileExists(dir + 'INFO') then
  1372.       list.Add(TRbRecycleBin.Create(dir + 'INFO')); // Windows 95 native
  1373.   end
  1374.   else
  1375.   begin
  1376.     if UserSID <> '' then
  1377.     begin
  1378.       dir := FDriveLetter + DriveDelim + PathDelim + 'Recycler' + PathDelim + UserSID + PathDelim;
  1379.  
  1380.       if FileExists(dir + 'INFO2') then
  1381.         list.Add(TRbRecycleBin.Create(dir + 'INFO2', UserSID)); // Windows 2000+
  1382.       if FileExists(dir + 'INFO') then
  1383.         list.Add(TRbRecycleBin.Create(dir + 'INFO', UserSID)); // Windows NT 4
  1384.     end
  1385.     else
  1386.     begin
  1387.       _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + 'Recycler', false);
  1388.     end;
  1389.   end;
  1390. end;
  1391.  
  1392. { TRbInfoAItem }
  1393.  
  1394. procedure TRbInfoAItem.ReadFromStream(stream: TStream);
  1395. var
  1396.   r: TRbInfoRecordA;
  1397. begin
  1398.   stream.ReadBuffer(r, SizeOf(r));
  1399.  
  1400.   FSourceDrive := Chr(Ord('A') + r.sourceDrive);
  1401.  
  1402.   // Win95 with IE4 and Win2000+:
  1403.   // Wenn ein Eintrag aus der INFO/INFO2 gelöscht wird, dann wird das erste Byte
  1404.   // von sourceAnsi auf Null gesetzt, damit die ganze INFO/INFO2 Datei nicht
  1405.   // ständig neu geschrieben werden muss (so wie es bei Win95 und WinNT4 der Fall war).
  1406.   // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
  1407.   // Zwecken eingesetzt werden soll.
  1408.   if r.sourceAnsi[0] = #0 then
  1409.   begin
  1410.     FRemovedEntry := true;
  1411.     r.sourceAnsi[0] := AnsiChar(FSourceDrive);
  1412.   end;
  1413.  
  1414.   FSourceAnsi := r.sourceAnsi;
  1415.   FSourceUnicode := AnsiCharArrayToWideString(r.sourceAnsi); // Unicode does not exist in INFO(1) structure
  1416.   FID := IntToStr(r.recordNumber);
  1417.   FDeletionTime := FileTimeToDateTime(r.deletionTime);
  1418.   FOriginalSize := r.originalSize;
  1419.  
  1420.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1421.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1422.   AnsiRemoveNulChars(FSourceAnsi);
  1423.   UnicodeRemoveNulChars(FSourceUnicode);
  1424. end;
  1425.  
  1426. function TRbInfoAItem.DeleteFile: boolean;
  1427. var
  1428.   r: string;
  1429. begin
  1430.   r := GetPhysicalFile;
  1431.   if DirectoryExists(r) then
  1432.     result := DeleteDirectory(r) // Usually, the old recycle bin does not allow folders. Just to be sure, we include the code.
  1433.   else
  1434.     result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung? --> Win95: Funktioniert
  1435.  
  1436.   // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Datei neu schreiben)
  1437. end;
  1438.  
  1439. function TRbInfoAItem.GetPhysicalFile: string;
  1440. begin
  1441.   if FRemovedEntry then
  1442.   begin
  1443.     result := '';
  1444.     Exit;
  1445.   end;
  1446.  
  1447.   // e.g. C:\...\DC0.doc
  1448.   result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
  1449.             'D' + (* SourceDrive *) Source[1] + ID + ExtractFileExt(Source);
  1450. end;
  1451.  
  1452. constructor TRbInfoAItem.Create(fs: TStream; AIndexFile: string);
  1453. begin
  1454.   inherited Create;
  1455.   ReadFromStream(fs);
  1456.   FIndexFile := AIndexFile;
  1457. end;
  1458.  
  1459. { TRbInfoWItem }
  1460.  
  1461. procedure TRbInfoWItem.ReadFromStream(stream: TStream);
  1462. var
  1463.   r: TRbInfoRecordW;
  1464. begin
  1465.   stream.ReadBuffer(r, SizeOf(r));
  1466.  
  1467.   // Win95 with IE4 and Win2000+:
  1468.   // Wenn ein Eintrag aus der INFO/INFO2 gelöscht wird, dann wird das erste Byte
  1469.   // von sourceAnsi auf Null gesetzt, damit die ganze INFO/INFO2 Datei nicht
  1470.   // ständig neu geschrieben werden muss (so wie es bei Win95 und WinNT4 der Fall war).
  1471.   // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
  1472.   // Zwecken eingesetzt werden soll.
  1473.   if r.sourceAnsi[0] = #0 then
  1474.   begin
  1475.     FRemovedEntry := true;
  1476.     r.sourceAnsi[0] := AnsiChar(r.sourceUnicode[0]);
  1477.   end;
  1478.  
  1479.   FSourceAnsi := r.sourceAnsi;
  1480.   FSourceUnicode := r.sourceUnicode;
  1481.   FID := IntToStr(r.recordNumber);
  1482.   FSourceDrive := Chr(Ord('A') + r.sourceDrive);
  1483.   FDeletionTime := FileTimeToDateTime(r.deletionTime);
  1484.   FOriginalSize := r.originalSize;
  1485.  
  1486.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1487.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1488.   AnsiRemoveNulChars(FSourceAnsi);
  1489.   UnicodeRemoveNulChars(FSourceUnicode);
  1490. end;
  1491.  
  1492. function TRbInfoWItem.DeleteFile: boolean;
  1493. var
  1494.   r: string;
  1495. begin
  1496.   r := GetPhysicalFile;
  1497.   if DirectoryExists(r) then
  1498.     result := DeleteDirectory(r)
  1499.   else
  1500.     result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung?
  1501.  
  1502.   // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Erstes Byte auf 0 setzen)
  1503. end;
  1504.  
  1505. function TRbInfoWItem.GetPhysicalFile: string;
  1506. begin
  1507.   if FRemovedEntry then
  1508.   begin
  1509.     result := '';
  1510.     Exit;
  1511.   end;
  1512.  
  1513.   (*
  1514.   This is actually a bit tricky...
  1515.   Win95 will choose the first letter of the AnsiSource name.
  1516.   WinNT will choose the first letter of the UnicodeSource name.
  1517.   WinXP will choose the driveNumber member.
  1518.  
  1519.   Windows XP is kinda buggy when it comes to changing a drive letter.
  1520.   For example, the drive E: was changed to K:
  1521.   The drive letter is 04 (E), the Source name begins with E:\ and the physical file is De0.txt .
  1522.   After the recycle bin is opened the first time:
  1523.   - The recycle bin will show the file origin as K:\ and not as E:\
  1524.   - The file was renamed from De0.txt to Dk0.txt
  1525.   - The file can be recovered at this time
  1526.   When the recycle bin is closed, the INFO2 file will not be corrected (which is a bug).
  1527.   So, if you open the recycle bin again, the record will be marked
  1528.   as deleted in the INFO file (the first byte will be set to 0),
  1529.   because Windows searches for De0.txt and doesn't find it.
  1530.  
  1531.   (This comment also applies to TRbInfoAItem.GetPhysicalFile)
  1532.   *)
  1533.  
  1534.   // e.g. C:\...\DC0.doc
  1535.   result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
  1536.             'D' + SourceDrive (* SourceUnicode[1] *) + ID + ExtractFileExt(SourceUnicode);
  1537. end;
  1538.  
  1539. constructor TRbInfoWItem.Create(fs: TStream; AIndexFile: string);
  1540. begin
  1541.   inherited Create;
  1542.   ReadFromStream(fs);
  1543.   FIndexFile := AIndexFile;
  1544. end;
  1545.  
  1546. { TRbVistaItem }
  1547.  
  1548. procedure TRbVistaItem.ReadFromStream(stream: TStream);
  1549. var
  1550.   r1: TRbVistaRecord1;
  1551.   r2: TRbVistaRecord2Head;
  1552.   r2SourceUnicode: array of WideChar;
  1553.   version: DWORD;
  1554. begin
  1555.   stream.ReadBuffer(version, SizeOf(version));
  1556.  
  1557.   if version = 1 then
  1558.   begin
  1559.     stream.Seek(0, soBeginning);
  1560.     stream.ReadBuffer(r1, SizeOf(r1));
  1561.     FSourceAnsi := AnsiString(WideCharArrayToWideString(r1.sourceUnicode)); // Invalid chars are automatically converted into '?'
  1562.     FSourceUnicode := WideCharArrayToWideString(r1.sourceUnicode);
  1563.     FID := ''; // will be added manually (at the constructor)
  1564.     FSourceDrive := r1.sourceUnicode[1];
  1565.     FDeletionTime := FileTimeToDateTime(r1.deletionTime);
  1566.     FOriginalSize := r1.originalSize;
  1567.   end
  1568.   else if version = 2 then
  1569.   begin
  1570.     stream.Seek(0, soBeginning);
  1571.     stream.ReadBuffer(r2, SizeOf(r2));
  1572.  
  1573.     SetLength(r2SourceUnicode, SizeOf(WideChar)*(r2.SourceCountChars-1));
  1574.     stream.Read(r2SourceUnicode[0], SizeOf(WideChar)*(r2.sourceCountChars-1));
  1575.  
  1576.     FSourceAnsi := AnsiString(WideCharArrayToWideString(r2sourceUnicode)); // Invalid chars are automatically converted into '?'
  1577.     FSourceUnicode := WideCharArrayToWideString(r2sourceUnicode);
  1578.     FID := ''; // will be added manually (at the constructor)
  1579.     FSourceDrive := r2sourceUnicode[1];
  1580.     FDeletionTime := FileTimeToDateTime(r2.deletionTime);
  1581.     FOriginalSize := r2.originalSize;
  1582.   end
  1583.   else
  1584.   begin
  1585.     raise Exception.CreateFmt('Invalid Vista index format version %d', [version]);
  1586.   end;
  1587.  
  1588.   // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  1589.   // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  1590.   AnsiRemoveNulChars(FSourceAnsi);
  1591.   UnicodeRemoveNulChars(FSourceUnicode);
  1592. end;
  1593.  
  1594. function TRbVistaItem.DeleteFile: boolean;
  1595. var
  1596.   r: string;
  1597. begin
  1598.   r := GetPhysicalFile;
  1599.   if DirectoryExists(r) then
  1600.     result := DeleteDirectory(r)
  1601.   else
  1602.     result := SysUtils.DeleteFile(r);
  1603.  
  1604.   SysUtils.DeleteFile(FIndexFile);
  1605. end;
  1606.  
  1607. function TRbVistaItem.GetPhysicalFile: string;
  1608. begin
  1609.   result := FIndexFile;
  1610.   result := StringReplace(Result, '$I', '$R', [rfIgnoreCase]);
  1611. end;
  1612.  
  1613. constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string);
  1614. begin
  1615.   inherited Create;
  1616.   ReadFromStream(fs);
  1617.   FIndexFile := AIndexFile;
  1618.   FID := AID;
  1619. end;
  1620.  
  1621. { TRecycleBinManager }
  1622.  
  1623. class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean;
  1624. var
  1625.   PSHEmptyRecycleBin: TSHEmptyRecycleBin;
  1626.   LibHandle: THandle;
  1627. begin
  1628.   // Source: http://www.dsdt.info/tipps/?id=176
  1629.   result := true;
  1630.   LibHandle := LoadLibrary(shell32);
  1631.   try
  1632.     if LibHandle <> 0 then
  1633.     begin
  1634.       @PSHEmptyRecycleBin := GetProcAddress(LibHandle, C_SHEmptyRecycleBin);
  1635.       if @PSHEmptyRecycleBin <> nil then
  1636.       begin
  1637.         PSHEmptyRecycleBin(hInstance, nil, flags);
  1638.       end
  1639.       else
  1640.         result := false;
  1641.     end
  1642.     else
  1643.       result := false;
  1644.   finally
  1645.     @PSHEmptyRecycleBin := nil;
  1646.     if LibHandle <> 0 then FreeLibrary(LibHandle);
  1647.   end;
  1648. end;
  1649.  
  1650. class function TRecycleBinManager.EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean;
  1651. const
  1652.   SHERB_NOCONFIRMATION = $00000001;
  1653.   SHERB_NOPROGRESSUI   = $00000002;
  1654.   SHERB_NOSOUND        = $00000004;
  1655. var
  1656.   flags: cardinal;
  1657. begin
  1658.   flags := 0;
  1659.  
  1660.   if not progress then
  1661.     flags := flags or SHERB_NOPROGRESSUI;
  1662.   if not confirmation then
  1663.     flags := flags or SHERB_NOCONFIRMATION;
  1664.   if not sound then
  1665.     flags := flags or SHERB_NOSOUND;
  1666.  
  1667.   result := EmptyOwnRecyclers(flags);
  1668. end;
  1669.  
  1670. class function TRecycleBinManager.GetGlobalMaxPercentUsage: integer;
  1671. var
  1672.   reg: TRegistry;
  1673.   purgeInfo: TRbWin95PurgeInfo;
  1674. const
  1675.   RES_DEFAULT = 10; // Windows 95 - Standardwert
  1676. begin
  1677.   if Win32MajorVersion >= 6 then
  1678.   begin
  1679.     // Only available till Windows XP
  1680.     result := -1;
  1681.     exit;
  1682.   end;
  1683.  
  1684.   result := RES_DEFAULT;
  1685.  
  1686.   reg := TRegistry.Create;
  1687.   try
  1688.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1689.  
  1690.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1691.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1692.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1693.     begin
  1694.       if reg.ValueExists('Percent') then
  1695.       begin
  1696.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1697.  
  1698.         result := reg.ReadInteger('Percent');
  1699.       end
  1700.       else if reg.ValueExists('PurgeInfo') then
  1701.       begin
  1702.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1703.  
  1704.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1705.         result := purgeInfo.percentGlobal;
  1706.       end;
  1707.  
  1708.       reg.CloseKey;
  1709.     end;
  1710.   finally
  1711.     reg.Free;
  1712.   end;
  1713. end;
  1714.  
  1715. class function TRecycleBinManager.GetGlobalNukeOnDelete: boolean;
  1716. var
  1717.   reg: TRegistry;
  1718.   purgeInfo: TRbWin95PurgeInfo;
  1719. const
  1720.   RES_DEFAULT = false; // Windows 95 - Standardwert
  1721. begin
  1722.   if Win32MajorVersion >= 6 then
  1723.   begin
  1724.     // Only available till Windows XP
  1725.     result := false;
  1726.     exit;
  1727.   end;
  1728.  
  1729.   result := RES_DEFAULT;
  1730.  
  1731.   reg := TRegistry.Create;
  1732.   try
  1733.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1734.  
  1735.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1736.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1737.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1738.     begin
  1739.       if reg.ValueExists('NukeOnDelete') then
  1740.       begin
  1741.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1742.  
  1743.         result := reg.ReadBool('NukeOnDelete');
  1744.       end
  1745.       else if reg.ValueExists('PurgeInfo') then
  1746.       begin
  1747.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1748.  
  1749.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1750.         result := (purgeInfo.NukeOnDeleteBits and $8000000) = $8000000; // bit 27
  1751.       end;
  1752.  
  1753.       reg.CloseKey;
  1754.     end;
  1755.   finally
  1756.     reg.Free;
  1757.   end;
  1758. end;
  1759.  
  1760. (* TODO:
  1761. There are more registry values (found in WinXP):
  1762.  
  1763. BitBucket\<driveletter>
  1764.   VolumeSerialNumber
  1765.   IsUnicode
  1766.  
  1767. *)
  1768.  
  1769. class function TRecycleBinManager.UsesGlobalSettings: boolean;
  1770. var
  1771.   reg: TRegistry;
  1772.   purgeInfo: TRbWin95PurgeInfo;
  1773. const
  1774.   RES_DEFAULT = true; // Windows 95 - Standardwert
  1775. begin
  1776.   if Win32MajorVersion >= 6 then
  1777.   begin
  1778.     // Only available till Windows XP
  1779.     result := false;
  1780.     exit;
  1781.   end;
  1782.  
  1783.   result := RES_DEFAULT;
  1784.  
  1785.   reg := TRegistry.Create;
  1786.   try
  1787.     reg.RootKey := HKEY_LOCAL_MACHINE;
  1788.  
  1789.     // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
  1790.     // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
  1791.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  1792.     begin
  1793.       if reg.ValueExists('UseGlobalSettings') then
  1794.       begin
  1795.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  1796.  
  1797.         result := reg.ReadBool('UseGlobalSettings');
  1798.       end
  1799.       else if reg.ValueExists('PurgeInfo') then
  1800.       begin
  1801.         // Windows 95 - Kodierte Informationen liegen in PurgeInfo
  1802.  
  1803.         reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
  1804.         result := purgeInfo.bGlobalSettings;
  1805.       end;
  1806.  
  1807.       reg.CloseKey;
  1808.     end;
  1809.   finally
  1810.     reg.Free;
  1811.   end;
  1812. end;
  1813.  
  1814. class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive});
  1815. var
  1816.   drive: AnsiChar;
  1817. begin
  1818.   for drive := 'A' to 'Z' do
  1819.     if RecycleBinPossible(drive) then
  1820.       list.Add(TRbDrive.Create(drive));
  1821. end;
  1822.  
  1823. class function TRecycleBinManager.OwnRecyclersEmpty: boolean;
  1824. var
  1825.   drives: TObjectList;
  1826.   i: integer;
  1827. begin
  1828.   result := true;
  1829.  
  1830.   drives := TObjectList.Create(true);
  1831.   try
  1832.     ListDrives(drives);
  1833.     for i := 0 to drives.Count - 1 do
  1834.     begin
  1835.       result := result and TRbDrive(drives.Items[i]).IsEmpty;
  1836.       if not result then break;
  1837.     end;
  1838.   finally
  1839.     drives.Free;
  1840.   end;
  1841. end;
  1842.  
  1843. class function TRecycleBinManager.OwnRecyclersNumItems: int64;
  1844. var
  1845.   drives: TObjectList;
  1846.   i: integer;
  1847. begin
  1848.   result := 0;
  1849.  
  1850.   drives := TObjectList.Create(true);
  1851.   try
  1852.     ListDrives(drives);
  1853.     for i := 0 to drives.Count - 1 do
  1854.     begin
  1855.       result := result + TRbDrive(drives.Items[i]).GetNumItems;
  1856.     end;
  1857.   finally
  1858.     drives.Free;
  1859.   end;
  1860. end;
  1861.  
  1862. class function TRecycleBinManager.OwnRecyclersSize: int64;
  1863. var
  1864.   drives: TObjectList;
  1865.   i: integer;
  1866. begin
  1867.   result := 0;
  1868.  
  1869.   drives := TObjectList.Create(true);
  1870.   try
  1871.     ListDrives(drives);
  1872.     for i := 0 to drives.Count - 1 do
  1873.     begin
  1874.       result := result + TRbDrive(drives.Items[i]).GetSize;
  1875.     end;
  1876.   finally
  1877.     drives.Free;
  1878.   end;
  1879. end;
  1880.  
  1881. class function TRecycleBinManager.RecycleBinPossible(Drive: AnsiChar): boolean;
  1882. var
  1883.   typ: Integer;
  1884. begin
  1885.   // Does the drive exist?
  1886.   // see http://www.delphipraxis.net/post2933.html
  1887.   result := GetLogicalDrives and (1 shl DriveLetterToDriveNumber(Drive)) <> 0;
  1888.   if not result then exit;
  1889.  
  1890.   // Is it a fixed drive? (Only they can have recycle bins)
  1891.   // TODO: is that correct, or can also have other drive types have recyclers?
  1892.   typ := GetDriveType(PChar(Drive + ':\'));
  1893.   result := typ = DRIVE_FIXED;
  1894. end;
  1895.  
  1896. class function TRecycleBinManager.RecyclerGetCurrentIconString: string;
  1897. begin
  1898.   if OwnRecyclersEmpty then
  1899.     result := RecyclerGetEmptyIconString
  1900.   else
  1901.     result := RecyclerGetFullIconString;
  1902. end;
  1903.  
  1904. class function TRecycleBinManager.RecyclerGetDefaultIconString: string;
  1905. var
  1906.   reg: TRegistry;
  1907. begin
  1908.   // Please note: The "default" icon is not always the icon of the
  1909.   // current recycle bin in its current state (full, empty)
  1910.   // At Windows 95b, the registry value actually did change every time the
  1911.   // recycle bin state did change, but at Windows 2000 I could not see any
  1912.   // update, even after reboot. So, the registry value is possible fixed as
  1913.   // default = empty on newer OS versions.
  1914.  
  1915.   reg := TRegistry.Create;
  1916.   try
  1917.     reg.RootKey := HKEY_CLASSES_ROOT;
  1918.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1919.     begin
  1920.       result := reg.ReadString('');
  1921.       reg.CloseKey;
  1922.     end;
  1923.   finally
  1924.     reg.Free;
  1925.   end;
  1926. end;
  1927.  
  1928. class function TRecycleBinManager.RecyclerGetEmptyIconString: string;
  1929. var
  1930.   reg: TRegistry;
  1931. begin
  1932.   reg := TRegistry.Create;
  1933.   try
  1934.     reg.RootKey := HKEY_CLASSES_ROOT;
  1935.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1936.     begin
  1937.       result := reg.ReadString('Empty');
  1938.       reg.CloseKey;
  1939.     end;
  1940.   finally
  1941.     reg.Free;
  1942.   end;
  1943. end;
  1944.  
  1945. class function TRecycleBinManager.RecyclerGetFullIconString: string;
  1946. var
  1947.   reg: TRegistry;
  1948. begin
  1949.   reg := TRegistry.Create;
  1950.   try
  1951.     reg.RootKey := HKEY_CLASSES_ROOT;
  1952.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then
  1953.     begin
  1954.       result := reg.ReadString('Full');
  1955.       reg.CloseKey;
  1956.     end;
  1957.   finally
  1958.     reg.Free;
  1959.   end;
  1960. end;
  1961.  
  1962. class function TRecycleBinManager.RecyclerGetInfoTip: string;
  1963. var
  1964.   reg: TRegistry;
  1965. begin
  1966.   // Not available in some older versions of Windows
  1967.  
  1968.   reg := TRegistry.Create;
  1969.   try
  1970.     reg.RootKey := HKEY_CLASSES_ROOT;
  1971.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then
  1972.     begin
  1973.       result := reg.ReadString('InfoTip');
  1974.       result := DecodeReferenceString(result);
  1975.  
  1976.       reg.CloseKey;
  1977.     end;
  1978.   finally
  1979.     reg.Free;
  1980.   end;
  1981. end;
  1982.  
  1983. class function TRecycleBinManager.RecyclerGetIntroText: string;
  1984. var
  1985.   reg: TRegistry;
  1986. begin
  1987.   // Not available in some older versions of Windows
  1988.  
  1989.   reg := TRegistry.Create;
  1990.   try
  1991.     reg.RootKey := HKEY_CLASSES_ROOT;
  1992.     if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then
  1993.     begin
  1994.       result := reg.ReadString('IntroText');
  1995.       result := DecodeReferenceString(result);
  1996.  
  1997.       reg.CloseKey;
  1998.     end;
  1999.   finally
  2000.     reg.Free;
  2001.   end;
  2002. end;
  2003.  
  2004. class function TRecycleBinManager.RecyclerGetName: string;
  2005. var
  2006.   reg: TRegistry;
  2007. begin
  2008.   // Windows 95b:
  2009.   // Change of CLSID\{645FF040-5081-101B-9F08-00AA002F954E} will change the desktop name of the recycle bin.
  2010.  
  2011.   // Windows 2000: If LocalizedString is available, the 3rd argument will be parsed
  2012.   // (if the third argument will removed, it will be read out from the DLL resource string automatically)
  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.       if reg.ValueExists('LocalizedString') then
  2020.       begin
  2021.         result := reg.ReadString('LocalizedString');
  2022.         result := DecodeReferenceString(result);
  2023.       end
  2024.       else
  2025.       begin
  2026.         result := reg.ReadString('');
  2027.       end;
  2028.  
  2029.       reg.CloseKey;
  2030.     end;
  2031.   finally
  2032.     reg.Free;
  2033.   end;
  2034. end;
  2035.  
  2036. class function TRecycleBinManager.RecyclerEmptyEventGetName: string;
  2037. var
  2038.   reg: TRegistry;
  2039. begin
  2040.   reg := TRegistry.Create;
  2041.   try
  2042.     reg.RootKey := HKEY_CURRENT_USER;
  2043.     if reg.OpenKeyReadOnly('AppEvents\EventLabels\EmptyRecycleBin') then
  2044.     begin
  2045.       result := reg.ReadString('');
  2046.       reg.CloseKey;
  2047.     end;
  2048.   finally
  2049.     reg.Free;
  2050.   end;
  2051. end;
  2052.  
  2053. class function TRecycleBinManager.RecyclerEmptyEventGetCurrentSound: string;
  2054. begin
  2055.   result := RecyclerEmptyEventGetSound('.Current');
  2056. end;
  2057.  
  2058. class function TRecycleBinManager.RecyclerEmptyEventGetDefaultSound: string;
  2059. begin
  2060.   result := RecyclerEmptyEventGetSound('.Default');
  2061. end;
  2062.  
  2063. class procedure TRecycleBinManager.RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
  2064. var
  2065.   reg: TRegistry;
  2066. begin
  2067.   reg := TRegistry.Create;
  2068.   try
  2069.     reg.RootKey := HKEY_CURRENT_USER;
  2070.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2071.     begin
  2072.       reg.GetKeyNames(AStringList);
  2073.       reg.CloseKey;
  2074.     end;
  2075.   finally
  2076.     reg.Free;
  2077.   end;
  2078. end;
  2079.  
  2080. class function TRecycleBinManager.RecyclerEmptyEventGetSound(ACategory: string): string;
  2081. var
  2082.   reg: TRegistry;
  2083. resourcestring
  2084.   LNG_SND_EVENT_CAT_ERROR = 'The category "%s" is not available for the notification event "%s".';
  2085. begin
  2086.   // Outputs an filename or empty string for no sound defined.
  2087.  
  2088.   reg := TRegistry.Create;
  2089.   try
  2090.     reg.RootKey := HKEY_CURRENT_USER;
  2091.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2092.     begin
  2093.       if reg.OpenKeyReadOnly(ACategory) then
  2094.       begin
  2095.         result := reg.ReadString('');
  2096.         reg.CloseKey;
  2097.       end
  2098.       else
  2099.         raise EEventCategoryNotDefined.CreateFmt(LNG_SND_EVENT_CAT_ERROR, [ACategory, 'EmptyRecycleBin']);
  2100.       reg.CloseKey;
  2101.     end;
  2102.   finally
  2103.     reg.Free;
  2104.   end;
  2105. end;
  2106.  
  2107. class function TRecycleBinManager.RecyclerQueryFunctionAvailable: boolean;
  2108. var
  2109.   RBHandle: THandle;
  2110.   SHQueryRecycleBin: TSHQueryRecycleBin;
  2111. begin
  2112.   // Windows 95 without Internet Explorer 4 has no SHQueryRecycleBinA.
  2113.   RBHandle := LoadLibrary(shell32);
  2114.   try
  2115.     if RBHandle <> 0 then
  2116.     begin
  2117.       SHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin);
  2118.       if not Assigned(@SHQueryRecycleBin) then
  2119.       begin
  2120.         FreeLibrary(RBHandle);
  2121.         RBHandle := 0;
  2122.       end;
  2123.     end;
  2124.  
  2125.     result := RBHandle <> 0;
  2126.   finally
  2127.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2128.   end;
  2129. end;
  2130.  
  2131. class function TRecycleBinManager.RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean;
  2132. var
  2133.   Operation: TSHFileOpStruct;
  2134. begin
  2135.   // Template: http://www.dsdt.info/tipps/?id=116
  2136.   with Operation do
  2137.   begin
  2138.     Wnd := hInstance; // OK?
  2139.     wFunc := FO_DELETE;
  2140.     pFrom := PChar(FileOrFolder + #0);
  2141.     pTo := nil;
  2142.     fFlags := FOF_ALLOWUNDO;
  2143.     if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
  2144.   end;
  2145.   Result := SHFileOperation(Operation) = 0;
  2146. end;
  2147.  
  2148. class function TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
  2149. var
  2150.   reg: TRegistry;
  2151. begin
  2152.   result := gpUndefined;
  2153.  
  2154.   reg := TRegistry.Create;
  2155.   try
  2156.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2157.     // even if gpedit.msc shows "Not configured"!
  2158.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2159.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2160.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2161.     begin
  2162.       if reg.ValueExists('NoRecycleFiles') then
  2163.       begin
  2164.         if reg.ReadBool('NoRecycleFiles') then
  2165.           result := gpEnabled
  2166.         else
  2167.           result := gpDisabled;
  2168.         Exit;
  2169.       end;
  2170.       reg.CloseKey;
  2171.     end;
  2172.     {$ENDIF}
  2173.  
  2174.     reg.RootKey := HKEY_CURRENT_USER;
  2175.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2176.     begin
  2177.       if reg.ValueExists('NoRecycleFiles') then
  2178.       begin
  2179.         if reg.ReadBool('NoRecycleFiles') then
  2180.           result := gpEnabled
  2181.         else
  2182.           result := gpDisabled;
  2183.       end;
  2184.       reg.CloseKey;
  2185.     end;
  2186.   finally
  2187.     reg.Free;
  2188.   end;
  2189. end;
  2190.  
  2191. class function TRecycleBinManager.RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
  2192. var
  2193.   reg: TRegistry;
  2194. begin
  2195.   result := gpUndefined;
  2196.   reg := TRegistry.Create;
  2197.   try
  2198.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2199.     // even if gpedit.msc shows "Not configured"!
  2200.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2201.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2202.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2203.     begin
  2204.       if reg.ValueExists('ConfirmFileDelete') then
  2205.       begin
  2206.         if reg.ReadBool('ConfirmFileDelete') then
  2207.           result := gpEnabled
  2208.         else
  2209.           result := gpDisabled;
  2210.         Exit;
  2211.       end;
  2212.       reg.CloseKey;
  2213.     end;
  2214.     {$ENDIF}
  2215.  
  2216.     reg.RootKey := HKEY_CURRENT_USER;
  2217.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2218.     begin
  2219.       if reg.ValueExists('ConfirmFileDelete') then
  2220.       begin
  2221.         if reg.ReadBool('ConfirmFileDelete') then
  2222.           result := gpEnabled
  2223.         else
  2224.           result := gpDisabled;
  2225.       end;
  2226.       reg.CloseKey;
  2227.     end;
  2228.   finally
  2229.     reg.Free;
  2230.   end;
  2231. end;
  2232.  
  2233. class function TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize: integer;
  2234. var
  2235.   reg: TRegistry;
  2236. begin
  2237.   result := -1;
  2238.   reg := TRegistry.Create;
  2239.   try
  2240.     // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered,
  2241.     // even if gpedit.msc shows "Not configured"!
  2242.     {$IFDEF GroupPolicyAcceptHKLMTrick}
  2243.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2244.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2245.     begin
  2246.       if reg.ValueExists('RecycleBinSize') then
  2247.       begin
  2248.         result := reg.ReadInteger('RecycleBinSize');
  2249.         Exit;
  2250.       end;
  2251.       reg.CloseKey;
  2252.     end;
  2253.     {$ENDIF}
  2254.  
  2255.     reg.RootKey := HKEY_CURRENT_USER;
  2256.     if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then
  2257.     begin
  2258.       if reg.ValueExists('RecycleBinSize') then
  2259.       begin
  2260.         result := reg.ReadInteger('RecycleBinSize');
  2261.       end;
  2262.       reg.CloseKey;
  2263.     end;
  2264.   finally
  2265.     reg.Free;
  2266.   end;
  2267. end;
  2268.  
  2269. class function TRecycleBinManager.RecyclerConfirmationDialogEnabled: boolean;
  2270. var
  2271.   gp: GPOLICYBOOL;
  2272. begin
  2273.   gp := RecyclerGroupPolicyConfirmFileDelete;
  2274.   if gp <> gpUndefined then
  2275.   begin
  2276.     result := gp = gpEnabled;
  2277.   end
  2278.   else
  2279.   begin
  2280.     result := RecyclerShellStateConfirmationDialogEnabled;
  2281.   end;
  2282. end;
  2283.  
  2284. class function TRecycleBinManager.RecyclerShellStateConfirmationDialogEnabled: boolean;
  2285. var
  2286.   lpss: SHELLSTATE;
  2287.   bNoConfirmRecycle: boolean;
  2288.  
  2289.   PSHGetSettings: TSHGetSettings;
  2290.   RBHandle: THandle;
  2291.  
  2292.   reg: TRegistry;
  2293.   rbuf: array[0..255] of byte;
  2294. begin
  2295.   PSHGetSettings := nil;
  2296.   result := false; // Avoid warning message
  2297.  
  2298.   RBHandle := LoadLibrary(shell32);
  2299.   try
  2300.     if RBHandle <> 0 then
  2301.     begin
  2302.       PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings);
  2303.       if not Assigned(@PSHGetSettings) then
  2304.       begin
  2305.         FreeLibrary(RBHandle);
  2306.         RBHandle := 0;
  2307.       end;
  2308.     end;
  2309.  
  2310.     if (RBHandle <> 0) and Assigned(PSHGetSettings) then
  2311.     begin
  2312.       ZeroMemory(@lpss, SizeOf(lpss));
  2313.       PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE);
  2314.       bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle
  2315.  
  2316.       result := not bNoConfirmRecycle;
  2317.     end
  2318.     else
  2319.     begin
  2320.       reg := TRegistry.Create;
  2321.       try
  2322.         // API function call failed. Probably because Windows is too old.
  2323.         // Try to read out from registry.
  2324.         // The 3rd bit of the 5th byte of "ShellState" is the value
  2325.         // of "fNoConfirmRecycle".
  2326.  
  2327.         reg.RootKey := HKEY_CURRENT_USER;
  2328.         if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer') then
  2329.         begin
  2330.           ZeroMemory(@rbuf, SizeOf(rbuf));
  2331.           reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf));
  2332.  
  2333.           // Lese 3tes Bit vom 5ten Byte
  2334.           bNoConfirmRecycle := ((rbuf[4] and 4) = 4);
  2335.           result := not bNoConfirmRecycle;
  2336.  
  2337.           reg.CloseKey;
  2338.         end
  2339.         else
  2340.         begin
  2341.           raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]);
  2342.         end;
  2343.       finally
  2344.         reg.Free;
  2345.       end;
  2346.     end;
  2347.   finally
  2348.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2349.   end;
  2350. end;
  2351.  
  2352. class procedure TRecycleBinManager.RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
  2353. var
  2354.   lpss: SHELLSTATE;
  2355.  
  2356.   PSHGetSetSettings: TSHGetSetSettings;
  2357.   RBHandle: THandle;
  2358.  
  2359.   reg: TRegistry;
  2360.   rbuf: array[0..255] of byte;
  2361.  
  2362.   //dwResult: DWORD;
  2363.   lpdwResult: PDWORD_PTR;
  2364. begin
  2365.   PSHGetSetSettings := nil;
  2366.   lpdwResult := nil;
  2367.  
  2368.   RBHandle := LoadLibrary(shell32);
  2369.   try
  2370.     if RBHandle <> 0 then
  2371.     begin
  2372.       PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
  2373.       if not Assigned(@PSHGetSetSettings) then
  2374.       begin
  2375.         FreeLibrary(RBHandle);
  2376.         RBHandle := 0;
  2377.       end;
  2378.     end;
  2379.  
  2380.     if (RBHandle <> 0) and Assigned(PSHGetSetSettings) then
  2381.     begin
  2382.       ZeroMemory(@lpss, SizeOf(lpss));
  2383.  
  2384.       PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get
  2385.  
  2386.       // Set 3rd bit equal to NewSetting
  2387.       if NewSetting then
  2388.         lpss.Flags1 := lpss.Flags1 or  $00000004
  2389.       else
  2390.         lpss.Flags1 := lpss.Flags1 and $FFFFFFFB;
  2391.  
  2392.       PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
  2393.  
  2394.       SendMessageTimeout (
  2395.         HWND_BROADCAST, WM_SETTINGCHANGE,
  2396.         0, lParam (pChar ('ShellState')),
  2397.         SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2398.       );
  2399.     end
  2400.     else
  2401.     begin
  2402.       reg := TRegistry.Create;
  2403.       try
  2404.         // API function call failed. Probably because Windows is too old.
  2405.         // Try to read out from registry.
  2406.         // The 3rd bit of the 5th byte of "ShellState" is the value
  2407.         // of "fNoConfirmRecycle".
  2408.  
  2409.         reg.RootKey := HKEY_CURRENT_USER;
  2410.         if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false) then
  2411.         begin
  2412.           ZeroMemory(@rbuf, SizeOf(rbuf));
  2413.  
  2414.           reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get
  2415.  
  2416.           // Set 3rd bit equal to NewSetting
  2417.           if NewSetting then
  2418.             rbuf[4] := rbuf[4] or  $04
  2419.           else
  2420.             rbuf[4] := rbuf[4] and $FB;
  2421.  
  2422.           reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
  2423.  
  2424.           SendMessageTimeout (
  2425.             HWND_BROADCAST, WM_SETTINGCHANGE,
  2426.             0, lParam (pChar ('ShellState')),
  2427.             SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2428.           );
  2429.  
  2430.           reg.CloseKey;
  2431.         end
  2432.         else
  2433.         begin
  2434.           raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSetSettings])]);
  2435.         end;
  2436.       finally
  2437.         reg.Free;
  2438.       end;
  2439.     end;
  2440.   finally
  2441.     if RBHandle <> 0 then FreeLibrary(RBHandle);
  2442.   end;
  2443. end;
  2444.  
  2445. { TRbRecycleBinItem }
  2446.  
  2447. function TRbRecycleBinItem.GetSource: string;
  2448. begin
  2449.   {$IFDEF UNICODE}
  2450.   result := SourceUnicode;
  2451.   {$ELSE}
  2452.   result := SourceAnsi;
  2453.   {$ENDIF}
  2454. end;
  2455.  
  2456. end.
  2457.