Subversion Repositories recyclebinunit

Rev

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

  1.  
  2. // ********************************************************************************
  3. // **** ATTENTION! This unit is not developed anymore.                        *****
  4. // **** Please use the new version RecBinUnit2.pas , which is Object-oriented *****
  5. // ********************************************************************************
  6.  
  7. ////////////////////////////////////////////////////////////////////////////////////
  8. // RECYCLE-BIN-FUNCTIONS BY DANIEL MARSCHALL                                      //
  9. // E-MAIL: info@daniel-marschall.de                                               //
  10. // WEB:    www.daniel-marschall.de                                                //
  11. ////////////////////////////////////////////////////////////////////////////////////
  12. // Revision: 01 NOV 2016                                                          //
  13. // This unit is freeware, but please link to my website if you are using it!      //
  14. ////////////////////////////////////////////////////////////////////////////////////
  15. // Successfully tested with:                                                      //
  16. // Windows 95b (without IE4 Shell Extensions)                                     //
  17. // Windows 95b (with IE4 Shell Extensions)                                        //
  18. // Windows 98-SE                                                                  //
  19. // Windows NT4 SP6                                                                //
  20. // Windows XP-SP3                                                                 //
  21. // Windows 2000-SP4                                                               //
  22. // Windows 2003 Server EE SP1                                                     //
  23. // Windows Vista                                                                  //
  24. // Windows 7                                                                      //
  25. ////////////////////////////////////////////////////////////////////////////////////
  26. // DOES **NOT** WORK WITH "VERSION 2" INDEX FILES USED IN LATER VERSIONS OF WIN10 //
  27. // USE RECYCLE BIN UNIT V2 INSTEAD!                                               //
  28. ////////////////////////////////////////////////////////////////////////////////////
  29. //                                                                                //
  30. //  Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //
  31. //  RecyclerGetDateTime() functions, because the unit "DateUtils" is missing.     //
  32. //  Warning! This is a platform unit.                                             //
  33. //                                                                                //
  34. //  To do! Can you help?                                                          //
  35. //    - Win7 : Drive GUIDs                                                        //
  36. //    - Win7 : Absolute vs. Relative size limitations                             //
  37. //    - WideString-Support (input/output)                                         //
  38. //    - Always do EOF before reading anything?                                    //
  39. //    - Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext?   //
  40. //    - RecyclerGetInfofiles() check additionally for removable device?           //
  41. //      RecyclerIsValid() is false.                                               //
  42. //    - Make it possible to empty the recycle bin of one specific drive!          //
  43. //                                                                                //
  44. //  Unknown! Do you know the answer?                                              //
  45. //    - How does Windows 9x/NT manage the daylight saving time (if it does)?      //
  46. //    - How does Windows Vista react to a RECYCLER\ folder on a NTFS device?      //
  47. //    - How does Windows Vista react to a RECYCLED\ folder on a FAT device?       //
  48. //                                                                                //
  49. //  Thanks to all these who have helped me solving coding problems.               //
  50. //  Thanks to SEBA for sending in the Windows Vista trash structure files.        //
  51. //  Thanks to OMATA for testing the unit with Delphi 4.                           //
  52. //  Thanks to DEITYSOU for making a bugfix of DriveExists()                       //
  53. //                                                                                //
  54. ////////////////////////////////////////////////////////////////////////////////////
  55.  
  56. (*
  57.  
  58. == TODO LISTE ==
  59.  
  60. - Wichtig! Windows XP: InfoTip, IntroText und LocalizedString sind Resourcenangaben und müssen ausgelesen werden!
  61. - Testen: Wie reagiert Windows, wenn Bitbucket\C existiert, aber kein Wert 'Percent' hat? Mit der Standardeinstellung?
  62. - Bug: Windows 2000 bei bestehenden Windows 95 Partition: Recycler Filename ist dann Recycled und nicht Recycler!
  63. - bug? w95 recycled file hat immer selben löschzeitpunkt und größe? war die nicht verschieden?
  64. - beachtet? bei leerem papierkorb auf fat ist weder info noch info2 vorhanden?
  65. - testen: auch möglich, einen vista papierkorb offline öffnen?
  66. - Problem: bei win95(ohne ie4) und win2000 gleichzeitiger installation: es existiert info UND info2!!!
  67. - Implement SETTER functions to every kind of configuration thing. (percentage etc)
  68. - Registry CURRENT_USER: Funktionen auch für fremde Benutzer zur Verfügung stellen?
  69. - Es sollte möglich sein, dass ein Laufwerk mehr als 1 Recycler beinhaltet -- behandeln
  70.  
  71. === Future Ideas ===
  72.  
  73. - Demoapplikation: Dateien statt Text als Explorer-Like (TListView)?
  74. - Einzelne Elemente oder alle wiederherstellen oder löschen
  75. - Konfiguration für Laufwerke ändern etc
  76. - IconString -> TIcon Convertion functions
  77. - platzreservierung in mb-angabe berechnen
  78. - I don't know if there exists any API function which checks the state at any internal way.
  79. - copy/move files from recyclebin
  80.  
  81. *)
  82.  
  83. // TODO: Also include BC++ Versions
  84. {$IFNDEF BCB}
  85. {$DEFINE DEL1UP}
  86. {$IFNDEF VER80}
  87. {$DEFINE DEL2UP}
  88. {$IFNDEF VER90}
  89. {$DEFINE DEL3UP}
  90. {$IFNDEF VER100}
  91. {$DEFINE DEL4UP}
  92. {$IFNDEF VER120}
  93. {$DEFINE DEL5UP}
  94. {$IFNDEF VER130}
  95. {$DEFINE DEL6UP}
  96. {$IFNDEF VER140}
  97. {$DEFINE DEL7UP}
  98. {$ENDIF}
  99. {$ENDIF}
  100. {$ENDIF}
  101. {$ENDIF}
  102. {$ENDIF}
  103. {$ENDIF}
  104. {$ENDIF}
  105.  
  106. {$IFDEF DEL7UP}
  107. {$WARN UNSAFE_TYPE OFF}
  108. {$WARN UNSAFE_CODE OFF}
  109. {$WARN UNSAFE_CAST OFF}
  110. {$ENDIF}
  111.  
  112. {$IFDEF DEL6UP}
  113. unit RecyclerFunctions platform;
  114. {$ELSE}
  115. unit RecyclerFunctions;
  116. {$ENDIF}
  117.  
  118. // Configuration
  119.  
  120. // If enabled, all functions with parameter "InfofileOrRecycleFolder" will
  121. // also accept files which are not the indexfile (then, a INFO2 or INFO file
  122. // will be searched in this directory).
  123. {.$DEFINE allow_all_filenames}
  124.  
  125. interface
  126.  
  127. uses
  128.   Windows, SysUtils, Classes, {$IFDEF DEL6UP}DateUtils,{$ENDIF}
  129.   ShellApi{$IFNDEF DEL6UP}, FileCtrl{$ENDIF}, Registry,
  130.   Messages, BitOps;
  131.  
  132. type
  133.   EUnknownState = class(Exception);
  134.   EEventCategoryNotDefined = class(Exception);
  135.   EAPICallError = class(Exception);
  136.  
  137.   PSHQueryRBInfo = ^TSHQueryRBInfo;
  138.   TSHQueryRBInfo = packed record
  139.     cbSize      : dword;
  140.     i64Size     : int64;
  141.     i64NumItems : int64;
  142.   end;
  143.  
  144.   GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
  145.  
  146. const
  147.   RECYCLER_CLSID = '{645FF040-5081-101B-9F08-00AA002F954E}';
  148.  
  149. {$IFDEF DEL6UP}
  150. function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
  151. function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
  152. function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
  153. function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
  154. {$ENDIF}
  155.  
  156. function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
  157. function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
  158. function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
  159. function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
  160.  
  161. function RecyclerGetSource(drive: char; fileid: string): string; overload;
  162. function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
  163. function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
  164. function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
  165.  
  166. procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
  167. procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
  168. procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
  169.  
  170. function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
  171. function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
  172. function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
  173. function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
  174.  
  175. function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
  176. function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
  177. function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
  178. function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
  179.  
  180. function RecyclerIsValid(drive: char): boolean; overload;
  181. function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
  182. function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
  183.  
  184. function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
  185. function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
  186. function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
  187. function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
  188.  
  189. function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
  190. function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
  191. function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
  192. function RecyclerGetPath(drive: char; UserSID: string): string; overload;
  193. function RecyclerGetPath(drive: char): string; overload;
  194.  
  195. procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
  196. procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
  197. procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
  198. procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
  199. procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
  200.  
  201. function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
  202. function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
  203. function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
  204.  
  205. function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
  206. function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
  207. function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
  208.  
  209. procedure RecyclerGetAllRecyclerDrives(result: TStringList);
  210.  
  211. function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
  212. function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
  213.  
  214. function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
  215. function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
  216.  
  217. function RecyclerConfirmationDialogEnabled: boolean;
  218. function RecyclerShellStateConfirmationDialogEnabled: boolean;
  219. procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
  220.  
  221. function RecyclerGetCurrentIconString: string;
  222. function RecyclerGetDefaultIconString: string;
  223. function RecyclerGetEmptyIconString: string;
  224. function RecyclerGetFullIconString: string;
  225.  
  226. function RecyclerGetName: string;
  227. function RecyclerGetInfoTip: string;
  228. function RecyclerGetIntroText: string;
  229.  
  230. function RecyclerEmptyEventGetName: string;
  231. function RecyclerEmptyEventGetCurrentSound: string;
  232. function RecyclerEmptyEventGetDefaultSound: string;
  233. procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
  234. function RecyclerEmptyEventGetSound(ACategory: string): string;
  235.  
  236. function RecyclerGlobalGetPercentUsage: integer;
  237. function RecyclerSpecificGetPercentUsage(Drive: Char): integer;
  238. function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;
  239.  
  240. function RecyclerGlobalIsNukeOnDelete: boolean;
  241. function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
  242. function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;
  243.  
  244. function RecyclerHasGlobalSettings: boolean;
  245.  
  246. function RecyclerIsEmpty: boolean; overload;
  247. function RecyclerIsEmpty(Drive: Char): boolean; overload;
  248.  
  249. function RecyclerGetNumItems: int64; overload;
  250. function RecyclerGetNumItems(Drive: Char): int64; overload;
  251.  
  252. function RecyclerGetSize: int64; overload;
  253. function RecyclerGetSize(Drive: Char): int64; overload;
  254.  
  255. function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo; overload;
  256. function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo; overload;
  257.  
  258. function RecyclerGetCLSID: string;
  259.  
  260. // Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer
  261. // 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben
  262. // werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da
  263. // unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:
  264. // - RecyclerIsEmpty
  265. // - RecyclerGetNumItems
  266. // - RecyclerGetSize
  267. // - RecyclerGetAPIInfo
  268. function RecyclerQueryFunctionAvailable: boolean;
  269.  
  270. function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
  271. function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
  272. function RecyclerGroupPolicyRecycleBinSize: integer;
  273.  
  274. function GPBoolToString(value: GPOLICYBOOL): String;
  275.  
  276. function RecyclerIsPossible(Drive: Char): boolean;
  277.  
  278. function RecyclerLibraryVersion: string;
  279.  
  280. implementation
  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.   {$IFDEF MSWINDOWS}
  330.     shell32  = 'shell32.dll';
  331.     advapi32 = 'advapi32.dll';
  332.   {$ENDIF}
  333.   {$IFDEF LINUX}
  334.     shell32  = 'libshell32.borland.so';
  335.     advapi32 = 'libwine.borland.so';
  336.   {$ENDIF}
  337.  
  338.   // Masks for the shellstate
  339.    SSF_SHOWALLOBJECTS  = $00000001;
  340.   SSF_SHOWEXTENSIONS  = $00000002;
  341.   SSF_HIDDENFILEEXTS  = $00000004;
  342.   SSF_SERVERADMINUI   = $00000004;
  343.   SSF_SHOWCOMPCOLOR   = $00000008;
  344.   SSF_SORTCOLUMNS     = $00000010;
  345.   SSF_SHOWSYSFILES    = $00000020;
  346.   SSF_DOUBLECLICKINWEBVIEW = $00000080;
  347.   SSF_SHOWATTRIBCOL   = $00000100;
  348.   SSF_DESKTOPHTML     = $00000200;
  349.   SSF_WIN95CLASSIC    = $00000400;
  350.   SSF_DONTPRETTYPATH  = $00000800;
  351.   SSF_SHOWINFOTIP     = $00002000;
  352.   SSF_MAPNETDRVBUTTON = $00001000;
  353.   SSF_NOCONFIRMRECYCLE = $00008000;
  354.   SSF_HIDEICONS       = $00004000;
  355.   SSF_FILTER          = $00010000;
  356.   SSF_WEBVIEW         = $00020000;
  357.   SSF_SHOWSUPERHIDDEN = $00040000;
  358.   SSF_SEPPROCESS      = $00080000;
  359.   SSF_NONETCRAWLING   = $00100000;
  360.   SSF_STARTPANELON    = $00200000;
  361.   SSF_SHOWSTARTPAGE   = $00400000;
  362.  
  363. // **********************************************************
  364. // COMPATIBILITY FUNCTIONS
  365. // **********************************************************
  366.  
  367. {$IFNDEF DEL5UP}
  368. function IncludeTrailingBackslash(str: string): string;
  369. begin
  370.   if Copy(str, length(str), 1) = '\' then    // TODO? Gibt es PathDelim in Delphi 4?
  371.     Result := str
  372.   else
  373.     Result := str + '\';
  374. end;
  375. {$ENDIF}
  376.  
  377. // **********************************************************
  378. // INTERNALLY USED FUNCTIONS
  379. // **********************************************************
  380.  
  381. resourcestring
  382.   LNG_UNEXPECTED_STATE = 'Cannot determinate state of "%s" because of an unknown value in the configuration of your operation system. Please contact the developer of the Recycler Bin Unit and help improving the determination methods!';
  383.   LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';
  384.   LNG_NOT_CALLABLE = '%s not callable';
  385.   LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s';
  386.  
  387. function _DeleteDirectory(const Name: string): boolean;
  388. var
  389.   F: TSearchRec;
  390. begin
  391.   result := true;
  392.   if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then
  393.   begin
  394.     try
  395.       repeat
  396.         if (F.Attr and faDirectory <> 0) then
  397.         begin
  398.           if (F.Name <> '.') and (F.Name <> '..') then
  399.           begin
  400.             result := result and _DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);
  401.           end;
  402.         end
  403.         else
  404.         begin
  405.           if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;
  406.         end;
  407.       until FindNext(F) <> 0;
  408.     finally
  409.       FindClose(F);
  410.     end;
  411.     if not RemoveDir(Name) then result := false;
  412.   end;
  413. end;
  414.  
  415. function _FileSize(FileName: string): int64;
  416. var
  417.   fs: TFileStream;
  418. begin
  419.   fs := TFileStream.Create(FileName, fmOpenRead);
  420.   try
  421.     result := fs.size;
  422.   finally
  423.     fs.free;
  424.   end;
  425. end;
  426.  
  427. function _DriveNum(Drive: Char): Byte;
  428. // a->0, ..., z->25
  429. var
  430.   tmp: string;
  431. begin
  432.   tmp := LowerCase(Drive);
  433.   result := Ord(tmp[1])-Ord('a');
  434. end;
  435.  
  436. function _registryReadDump(AReg: TRegistry; AName: string): string;
  437. const
  438.   // Win2000 RegEdit has set the max input length of a REG_BINARY to $3FFF.
  439.   // Probably its the longest possible binary string and not just a GUI limit.
  440.   BufMax = $3FFF;
  441. var
  442.   buf: array[0..BufMax] of byte;
  443.   i: integer;
  444.   realsize: integer;
  445. begin
  446.   realsize := AReg.ReadBinaryData(AName, buf, SizeOf(buf));
  447.  
  448.   for i := 0 to realsize-1 do
  449.   begin
  450.     result := result + chr(buf[i]);
  451.   end;
  452. end;
  453.  
  454. function _GetStringFromDLL(filename: string; num: integer): string;
  455. const
  456.   // http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp
  457.   MAX_BUF = 4097; // OK?
  458. var
  459.   hLib: THandle;
  460.   buf: array[0..MAX_BUF] of char;
  461. begin
  462.   hLib := LoadLibrary(PChar(filename));
  463.   try
  464.     LoadString(hLib, num, buf, sizeof(buf));
  465.     result := buf;
  466.   finally
  467.     FreeLibrary(hLib);
  468.   end;
  469. end;
  470.  
  471. // http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html
  472. function _ExpandEnvStr(const szInput: string): string;
  473. const
  474.   MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
  475. begin
  476.   SetLength(Result,MAXSIZE);
  477.   SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
  478.     @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
  479. end;
  480.  
  481. // Beispiele
  482. // Papierkorb                                                 -- Windows 95
  483. // @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000
  484.  
  485. function _DecodeReferenceString(s: string): string;
  486. var
  487.   dll, id, lang, cache: string;
  488.   sl, sl2: tstringlist;
  489. begin
  490.   if Copy(s, 1, 1) = '@' then
  491.   begin
  492.     // Referenz auf eine DLL
  493.     // @<dll>,-<id>[@<lang>][,<cache>]
  494.  
  495.     sl := TStringList.Create;
  496.     try
  497.       // '@' am Anfang entfernen
  498.       s := Copy(s, 2, length(s)-1);
  499.  
  500.       // Nach ',' auftrennen
  501.       // sl[0] --> dll
  502.       // sl[1] --> -id@lang
  503.       // sl[2] --> cache
  504.       sl.CommaText := s;
  505.  
  506.       if sl.Count > 2 then
  507.       begin
  508.         // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden
  509.         // Ist bei Windows 2000 der Fall
  510.         cache := sl[2];
  511.         result := cache;
  512.         exit;
  513.       end;
  514.  
  515.       if sl.Count > 1 then
  516.       begin
  517.         dll := sl[0];
  518.  
  519.         sl2 := TStringList.Create;
  520.         try
  521.           // Nach '@' auftrennen
  522.           // sl2[0] --> id
  523.           // sl2[1] --> lang
  524.           sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);
  525.  
  526.           id := sl2[0];
  527.  
  528.           if sl2.Count > 1 then
  529.           begin
  530.             // ToDo: In Zukunft beachten, sofern möglich
  531.             lang := sl2[1];
  532.           end;
  533.  
  534.           // Umgebungsvariablen erkennen und Minuszeichen entfernen
  535.           result := _GetStringFromDLL(_ExpandEnvStr(dll), -StrToInt(id));
  536.         finally
  537.           sl2.Free;
  538.         end;
  539.       end
  540.       else
  541.       begin
  542.         // Zu wenige Informationen!
  543.  
  544.         result := '';
  545.       end;
  546.     finally
  547.       sl.Free;
  548.     end;
  549.   end
  550.   else
  551.   begin
  552.     // Kein Hinweis auf eine Referenz
  553.     result := s;
  554.   end;
  555. end;
  556.  
  557. function _readInt8(const Stream: TStream): byte;
  558. var
  559.   I: integer;
  560. begin
  561.   i := 0;
  562.   Stream.ReadBuffer(i, 1);
  563.   Result := i;
  564. end;
  565.  
  566. function _readInt32(const Stream: TStream): Longword;
  567. var
  568.   I: integer;
  569. begin
  570.   i := 0;
  571.   Stream.ReadBuffer(i, 4);
  572.   Result := i;
  573. end;
  574.  
  575. function _readInt64(const Stream: TStream): int64;
  576. var
  577.   I: int64;
  578. begin
  579.   i := 0;
  580.   Stream.ReadBuffer(i, 8);
  581.   Result := i;
  582. end;
  583.  
  584. function _readChar(const Stream: TStream): char;
  585. var
  586.   C: Char;
  587. begin
  588.   C := #0;
  589.   Stream.ReadBuffer(C, 1);
  590.   Result := C;
  591. end;
  592.  
  593. function _readNullTerminatedString(const Stream: TStream): String;
  594. var
  595.   S: String;
  596.   C: Char;
  597. begin
  598.   S := '';
  599.   repeat
  600.     Stream.ReadBuffer(C, 1);
  601.     if (C <> #0) then
  602.       S := S + C;
  603.   until C = #0;
  604.   Result := S;
  605. end;
  606.  
  607. // http://www.delphipraxis.net/post761928.html#761928
  608. function _readNullTerminatedWideString(const Stream: TStream): WideString;
  609. var
  610.   S: WideString;
  611.   WC: WideChar;
  612. begin
  613.   S := '';
  614.   repeat
  615.     Stream.ReadBuffer(WC, 2);
  616.     if (WC <> #0) then
  617.       S := S + WC;
  618.   until WC = #0;
  619.   Result := S;
  620. end;
  621.  
  622. // http://www.delphipraxis.net/post340194.html#340194
  623. function _nowUTC: TDateTime;
  624. var
  625.   SystemTime: TSystemTime;
  626. begin
  627.   GetSystemTime(SystemTime);
  628.   with SystemTime do
  629.   begin
  630.     Result := EncodeDate(wYear, wMonth, wDay) +
  631.               EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
  632.   end;
  633. end;
  634.  
  635. {$IFDEF DEL6UP}
  636. function _getGMTDifference(): extended;
  637. begin
  638.   result := - (datetimetounix(_nowUTC())-datetimetounix(Now())) / 3600;
  639. end;
  640.  
  641. function _fileTimeToDateTime(FileTime: int64): TDateTime;
  642. begin
  643.   // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf
  644.   // UnixTime = 0.0000001 * NTTime + 11644473600
  645.   // This is wrong! The correct formula is:
  646.   // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600
  647.   // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)
  648.   result := unixtodatetime(FileTime div 10000000 - 11644473600 + round(_getGMTDifference() * 3600));
  649. end;
  650. {$ENDIF}
  651.  
  652. // http://www.delphipraxis.net/post471470.html
  653. function _getAccountSid(const Server, User: WideString; var Sid: PSID): DWORD;
  654. var
  655.   dwDomainSize, dwSidSize: DWord;
  656.   R: LongBool;
  657.   wDomain: WideString;
  658.   Use: DWord;
  659. begin
  660.   Result := 0;
  661.   SetLastError(0);
  662.   dwSidSize := 0;
  663.   dwDomainSize := 0;
  664.   R := LookupAccountNameW(PWideChar(Server), PWideChar(User), nil, dwSidSize,
  665.        nil, dwDomainSize, Use);
  666.   if (not R) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
  667.   begin
  668.     SetLength(wDomain, dwDomainSize);
  669.     Sid := GetMemory(dwSidSize);
  670.     R := LookupAccountNameW(PWideChar(Server), PWideChar(User), Sid,
  671.          dwSidSize, PWideChar(wDomain), dwDomainSize, Use);
  672.     if not R then
  673.     begin
  674.       FreeMemory(Sid);
  675.       Sid := nil;
  676.     end;
  677.   end
  678.   else
  679.     Result := GetLastError;
  680. end;
  681.  
  682. const
  683.   UNLEN = 256; // lmcons.h
  684.  
  685. // Template:
  686. // http://www.latiumsoftware.com/en/pascal/0014.php
  687. function _getLoginNameW: widestring;
  688. var
  689.   Buffer: array[0..UNLEN] of widechar;
  690.   Size: DWORD;
  691. begin
  692.   Size := SizeOf(Buffer);
  693.   if GetUserNameW(Buffer, Size) then
  694.     Result := Buffer
  695.   else
  696.     Result := 'User';
  697. end;
  698.  
  699. function _ConvertSidToStringSidA(SID: PSID; var strSID: LPSTR): boolean;
  700. type
  701.   DllReg = function(SID: PSID; var StringSid: LPSTR): Boolean; stdcall;
  702. var
  703.   hDll: THandle;
  704.   dr: DllReg;
  705. begin
  706.   result := false;
  707.   hDll := LoadLibrary(advapi32);
  708.   if hDll <> 0 then
  709.   begin
  710.     @dr := GetProcAddress(hDll, 'ConvertSidToStringSidA');
  711.  
  712.     if assigned(dr) then
  713.     begin
  714.       result := dr(SID, strSID);
  715.     end;
  716.   end;
  717. end;
  718.  
  719. const
  720.   winternl_lib = 'Ntdll.dll';
  721.  
  722. type
  723.   USHORT = Word;
  724.   PWSTR = PWidechar;
  725.   PCWSTR = PWideChar;
  726.  
  727.    NTSTATUS = Longword;
  728.  
  729.   _UNICODE_STRING = record
  730.     Length: USHORT;
  731.     MaximumLength: USHORT;
  732.     Buffer: PWSTR;
  733.   end;
  734.   UNICODE_STRING = _UNICODE_STRING;
  735.   PUNICODE_STRING = ^UNICODE_STRING;
  736.  
  737. function _RtlConvertSidToUnicodeString(
  738.   UnicodeString: PUNICODE_STRING;
  739.   Sid: PSID;
  740.   AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
  741. type
  742.   DllReg = function(UnicodeString: PUNICODE_STRING;
  743.   Sid: PSID;
  744.   AllocateDestinationString: BOOLEAN): NTSTATUS; stdcall;
  745. var
  746.   hDll: THandle;
  747.   dr: DllReg;
  748. begin
  749.   result := $FFFFFFFF;
  750.   hDll := LoadLibrary(winternl_lib);
  751.   if hDll = 0 then Exit;
  752.   try
  753.     @dr := GetProcAddress(hDll, 'RtlConvertSidToUnicodeString');
  754.     if not Assigned(dr) then Exit;
  755.     result := dr(UnicodeString, Sid, AllocateDestinationString);
  756.   finally
  757.     FreeLibrary(hDll);
  758.   end;
  759. end;
  760.  
  761. procedure _RtlFreeUnicodeString(UnicodeString: PUNICODE_STRING); stdcall;
  762. type
  763.   DllReg = procedure(UnicodeString: PUNICODE_STRING); stdcall;
  764. var
  765.   hDll: THandle;
  766.   dr: DllReg;
  767. begin
  768.   hDll := LoadLibrary(winternl_lib);
  769.   if hDll = 0 then Exit;
  770.   try
  771.     @dr := GetProcAddress(hDll, 'RtlFreeUnicodeString');
  772.     if not Assigned(dr) then Exit;
  773.     dr(UnicodeString);
  774.   finally
  775.     FreeLibrary(hDll);
  776.   end;
  777. end;
  778.  
  779. function _NT_SidToString(SID: PSID; var strSID: string): boolean;
  780. var
  781.   pus: PUNICODE_STRING;
  782.   us: UNICODE_STRING;
  783. begin
  784.   pus := @us;
  785.   result := _RtlConvertSidToUnicodeString(pus, SID, true) = 0;
  786.   if not result then Exit;
  787.   strSID := pus^.Buffer;
  788.   UniqueString(strSID);
  789.   _RtlFreeUnicodeString(pus);
  790.   result := true;
  791. end;
  792.  
  793. // Source: http://www.delphipraxis.net/post471470.html
  794. // Modified
  795. function _getMySID(): string;
  796. var
  797.   SID: PSID;
  798.   strSID: PAnsiChar;
  799.   err: DWORD;
  800. begin
  801.   SID := nil;
  802.  
  803.   err := _getAccountSid('', _getLoginNameW(), SID);
  804.   try
  805.     if err > 0 then
  806.     begin
  807.       EAPICallError.Create('_getAccountSid:' + SysErrorMessage(err));
  808.       Exit;
  809.     end;
  810.  
  811.     if _ConvertSidToStringSidA(SID, strSID) then
  812.     begin
  813.       result := string(strSID);
  814.       Exit;
  815.     end;
  816.  
  817.     if _NT_SidToString(SID, result) then Exit;
  818.  
  819.     EAPICallError.Create('_getMySID:' + SysErrorMessage(err));
  820.   finally
  821.     if Assigned(SID) then FreeMemory(SID);
  822.   end;
  823. end;
  824.  
  825. // Originalcode aus http://www.delphipraxis.net/post2933.html
  826. function _DriveExists(DriveByte: Byte): Boolean; overload;
  827. begin
  828.   Result := GetLogicalDrives and (1 shl DriveByte) <> 0;
  829. end;
  830.  
  831. function _driveExists(Drive: Char): Boolean; overload;
  832. var
  833.   DriveByte: Byte;
  834.   tmp: string;
  835. begin
  836.   // Make drive letter upper case (for older Delphi versions)
  837.   tmp := UpperCase(Drive);
  838.   Drive := tmp[1];
  839.  
  840.   DriveByte := Ord(Drive) - Ord('A');
  841.   Result := _DriveExists(DriveByte);
  842. end;
  843.  
  844. function _isFAT(drive: char): boolean;
  845. var
  846.   Dummy2: DWORD;
  847.   Dummy3: DWORD;
  848.   FileSystem: array[0..MAX_PATH] of char;
  849.   VolumeName: array[0..MAX_PATH] of char;
  850.   s: string;
  851. begin
  852.   result := false;
  853.   if _driveExists(drive) then
  854.   begin
  855.     s := drive + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll
  856.     GetVolumeInformation(PChar(s), VolumeName,
  857.       SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem));
  858.     result := uppercase(copy(FileSystem, 0, 3)) = 'FAT';
  859.   end;
  860. end;
  861.  
  862. // **********************************************************
  863. // VISTA AND WINDOWS 7 FUNCTIONS, INTERNAL USED
  864. // **********************************************************
  865.  
  866. const
  867.   vista_valid_index_size = $220; // 544
  868.  
  869. function _isFileVistaRealfile(filename: string): boolean;
  870. begin
  871.   result := uppercase(copy(extractfilename(filename), 0, 2)) = '$R';
  872. end;
  873.  
  874. function _isFileVistaIndexfile(filename: string): boolean;
  875. begin
  876.   result := uppercase(copy(extractfilename(filename), 0, 2)) = '$I';
  877. end;
  878.  
  879. function _isFileVistaNamed(filename: string): boolean;
  880. begin
  881.   result := _isFileVistaIndexfile(filename) or
  882.             _isFileVistaRealfile(filename);
  883. end;
  884.  
  885. function _VistaChangeRealfileToIndexfile(realfile: string): string;
  886. begin
  887.   if _isFileVistaRealfile(realfile) then
  888.   begin
  889.     result := extractfilepath(realfile)+'$I'+
  890.       copy(extractfilename(realfile), 3, length(extractfilename(realfile))-2);
  891.   end
  892.   else
  893.     result := realfile; // ignore, even if it is not a vista recycle-file
  894. end;
  895.  
  896. function _VistaChangeIndexfileToRealfile(indexfile: string): string;
  897. begin
  898.   if _isFileVistaIndexfile(indexfile) then
  899.   begin
  900.     result := extractfilepath(indexfile)+'$R'+
  901.       copy(extractfilename(indexfile), 3, length(extractfilename(indexfile))-2);
  902.   end
  903.   else
  904.     result := indexfile; // ignore, even if it is not a vista recycle-file
  905. end;
  906.  
  907. procedure _VistaListIndexes(recyclerpath: string; result: TStringList);
  908. var
  909.   sr: TSearchRec;
  910.   r: Integer;
  911.   tmp: string;
  912. begin
  913.   tmp := recyclerpath;
  914.   tmp := IncludeTrailingBackslash(tmp);
  915.  
  916.   if not directoryexists(tmp) then exit;
  917.  
  918.   r := FindFirst(tmp+PathDelim + '$I*', faAnyFile, sr);
  919.   while r = 0 do
  920.   begin
  921.     if (sr.Name <> '.') and (sr.Name <> '..') then
  922.     begin
  923.       if sr.Size = vista_valid_index_size then
  924.       begin
  925.         result.Add(copy(sr.name, 3, length(sr.name)-2));
  926.       end;
  927.     end;
  928.     r := FindNext(sr);
  929.   end;
  930.  
  931.   FindClose(sr);
  932. end;
  933.  
  934. function _VistaCurrentFilename(infofilename: string): string;
  935. begin
  936.   result := extractfilename(infofilename);
  937.  
  938.   if _isFileVistaRealfile(result) then
  939.   begin
  940.     exit;
  941.   end;
  942.  
  943.   if _isFileVistaIndexfile(result) then
  944.   begin
  945.     result := _VistaChangeIndexfileToRealfile(result);
  946.     exit;
  947.   end;
  948.  
  949.   result := copy(result, 3, length(result)-2);
  950.   result := '$R'+result;
  951. end;
  952.  
  953. function _VistaGetSourceDrive(infofile: string): char;
  954. var
  955.   fs: TFileStream;
  956.   tmp: string;
  957. const
  958.   drive_vista_position = $18;
  959. begin
  960.   result := #0;
  961.  
  962.   tmp := infofile;
  963.   tmp := _VistaChangeRealfileToIndexfile(tmp);
  964.   if not fileexists(tmp) then exit;
  965.  
  966.   fs := TFileStream.Create(tmp, fmOpenRead);
  967.   try
  968.     fs.seek(drive_vista_position, soFromBeginning);
  969.     result := _readChar(fs);
  970.   finally
  971.     fs.free;
  972.   end;
  973. end;
  974.  
  975. {$IFDEF DEL6UP}
  976. function _VistaGetDateTime(infofile: string): TDateTime;
  977. var
  978.   fs: TFileStream;
  979.   tmp: string;
  980. const
  981.   timestamp_vista_position = $10;
  982. begin
  983.   result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
  984.  
  985.   tmp := infofile;
  986.   tmp := _VistaChangeRealfileToIndexfile(tmp);
  987.   if not fileexists(tmp) then exit;
  988.  
  989.   fs := TFileStream.Create(tmp, fmOpenRead);
  990.   try
  991.     fs.seek(timestamp_vista_position, soFromBeginning);
  992.     result := _fileTimeToDateTime(_readInt64(fs));
  993.   finally
  994.     fs.free;
  995.   end;
  996. end;
  997. {$ENDIF}
  998.  
  999. function _VistaGetSourceUnicode(infofile: string): string;
  1000. var
  1001.   fs: TFileStream;
  1002.   tmp: string;
  1003. const
  1004.   unicode_vista_position = $18;
  1005. begin
  1006.   result := '';
  1007.  
  1008.   tmp := infofile;
  1009.   tmp := _VistaChangeRealfileToIndexfile(tmp);
  1010.   if not fileexists(tmp) then exit;
  1011.  
  1012.   fs := TFileStream.Create(tmp, fmOpenRead);
  1013.   try
  1014.     fs.seek(unicode_vista_position, soFromBeginning);
  1015.     result := _readNullTerminatedWideString(fs);
  1016.   finally
  1017.     fs.free;
  1018.   end;
  1019. end;
  1020.  
  1021. function _VistaOriginalSize(infofile: string): integer;
  1022. var
  1023.   fs: TFileStream;
  1024.   tmp: string;
  1025. const
  1026.   size_vista_position = $8;
  1027. begin
  1028.   result := -1;
  1029.  
  1030.   tmp := infofile;
  1031.   tmp := _VistaChangeRealfileToIndexfile(tmp);
  1032.   if not fileexists(tmp) then exit;
  1033.  
  1034.   fs := TFileStream.Create(tmp, fmOpenRead);
  1035.   try
  1036.     fs.seek(size_vista_position, soFromBeginning);
  1037.     result := _readInt32(fs);
  1038.   finally
  1039.     fs.free;
  1040.   end;
  1041. end;
  1042.  
  1043. function _checkInfo1or2File(filename: string): boolean;
  1044. var
  1045.   fs: TStream;
  1046.   record_length: integer;
  1047. const
  1048.   length_position = $C;
  1049.   empty_size = 20;
  1050. begin
  1051.   fs := TFileStream.Create(filename, fmOpenRead);
  1052.   try
  1053.     fs.seek(length_position, soFromBeginning);
  1054.     record_length := _readInt32(fs);
  1055.  
  1056.     // Check the file length
  1057.     if record_length = 0 then
  1058.       result := false
  1059.     else
  1060.       result := (fs.size - empty_size) mod record_length = 0;
  1061.   finally
  1062.     fs.free;
  1063.   end;
  1064. end;
  1065.  
  1066. function _VistaIsValid(infofile: string): boolean;
  1067. var
  1068.   tmp: string;
  1069. begin
  1070.   result := false;
  1071.  
  1072.   tmp := infofile;
  1073.   tmp := _VistaChangeRealfileToIndexfile(tmp);
  1074.   if not fileexists(tmp) then exit;
  1075.  
  1076.   // Check the file length
  1077.   result := _FileSize(tmp) = vista_valid_index_size;
  1078. end;
  1079.  
  1080. // **********************************************************
  1081. // PUBLIC FUNCTIONS
  1082. // **********************************************************
  1083.  
  1084. {$IFDEF DEL6UP}
  1085.  
  1086. function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
  1087. begin
  1088.   result := RecyclerGetDateTime(InfofileOrRecycleFolder, '');
  1089. end;
  1090.  
  1091. function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
  1092. begin
  1093.   result := RecyclerGetDateTime(drive, '', fileid);
  1094. end;
  1095.  
  1096. function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
  1097. var
  1098.   infofile: string;
  1099. begin
  1100.   infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1101.   result := RecyclerGetDateTime(infofile, fileid);
  1102. end;
  1103.  
  1104. function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
  1105. var
  1106.   fs: TFileStream;
  1107.   i, record_length: integer;
  1108.   tmp: string;
  1109. const
  1110.   length_position = $C;
  1111.   unique_index_position = $118;
  1112.   timestamp_position = $120;
  1113. begin
  1114.   // FILETIME does start at 01.01.1601 00:00:00 (GMT)
  1115.   result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
  1116.  
  1117.   tmp := InfofileOrRecycleFolder;
  1118.  
  1119.   if _isFileVistaNamed(tmp) then
  1120.   begin
  1121.     result := _VistaGetDateTime(tmp);
  1122.     exit;
  1123.   end;
  1124.  
  1125.   {$IFDEF allow_all_filenames}
  1126.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1127.   begin
  1128.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1129.       tmp := extractfilepath(tmp)+'INFO2'
  1130.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1131.       tmp := extractfilepath(tmp)+'INFO';
  1132.   end;
  1133.   {$ENDIF}
  1134.  
  1135.   if directoryexists(tmp) then
  1136.   begin
  1137.     tmp := IncludeTrailingBackslash(tmp);
  1138.  
  1139.     if fileexists(tmp+'$I'+id) then
  1140.     begin
  1141.       result := _VistaGetDateTime(tmp+'$I'+id);
  1142.       exit;
  1143.     end
  1144.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1145.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1146.   end;
  1147.  
  1148.   if not fileexists(tmp) then exit;
  1149.   if not RecyclerIsValid(tmp) then exit;
  1150.  
  1151.   fs := TFileStream.Create(tmp, fmOpenRead);
  1152.   try
  1153.     fs.seek(length_position, soFromBeginning);
  1154.     record_length := _readInt32(fs);
  1155.  
  1156.     i := -1;
  1157.     repeat
  1158.       inc(i);
  1159.       if unique_index_position+i*record_length > fs.size then break;
  1160.       fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1161.       if inttostr(_readInt32(fs)) = id then
  1162.       begin
  1163.         fs.seek(timestamp_position+i*record_length, soFromBeginning);
  1164.         result := _fileTimeToDateTime(_readInt64(fs));
  1165.         break;
  1166.       end;
  1167.       until false;
  1168.   finally
  1169.     fs.free;
  1170.   end;
  1171. end;
  1172.  
  1173. {$ENDIF}
  1174.  
  1175. ////////////////////////////////////////////////////////////////////////////////
  1176.  
  1177. function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
  1178. begin
  1179.   result := RecyclerGetSourceUnicode(InfofileOrRecycleFolder, '');
  1180. end;
  1181.  
  1182. function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
  1183. begin
  1184.   result := RecyclerGetSourceUnicode(drive, '', fileid);
  1185. end;
  1186.  
  1187. function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
  1188. var
  1189.   infofile: string;
  1190. begin
  1191.   if Win32Platform = VER_PLATFORM_WIN32_NT then
  1192.   begin
  1193.     infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1194.     result := RecyclerGetSourceUnicode(infofile, fileid);
  1195.   end
  1196.   else
  1197.   begin
  1198.     // Windows 9x does not support unicode
  1199.     result := RecyclerGetSource(drive, UserSID, fileid);
  1200.   end;
  1201. end;
  1202.  
  1203. function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
  1204. var
  1205.   fs: TFileStream;
  1206.   i, record_length: integer;
  1207.   tmp: string;
  1208. const
  1209.   length_position = $C;
  1210.   unique_index_position = $118;
  1211.   unicode_source_position = $12C;
  1212. begin
  1213.   result := '';
  1214.  
  1215.   tmp := InfofileOrRecycleFolder;
  1216.  
  1217.   if _isFileVistaNamed(tmp) then
  1218.   begin
  1219.     // Vista only gives unicode names
  1220.     result := _VistaGetSourceUnicode(tmp);
  1221.     exit;
  1222.   end;
  1223.  
  1224.   {$IFDEF allow_all_filenames}
  1225.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1226.   begin
  1227.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1228.       tmp := extractfilepath(tmp)+'INFO2'
  1229.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1230.       tmp := extractfilepath(tmp)+'INFO';
  1231.   end;
  1232.   {$ENDIF}
  1233.  
  1234.   if directoryexists(tmp) then
  1235.   begin
  1236.     tmp := IncludeTrailingBackslash(tmp);
  1237.  
  1238.     if fileexists(tmp+'$I'+id) then
  1239.     begin
  1240.       // Vista only gives unicode names
  1241.       result := _VistaGetSourceUnicode(tmp+'$I'+id);
  1242.       exit;
  1243.     end
  1244.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1245.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1246.   end;
  1247.  
  1248.   if not fileexists(tmp) then exit;
  1249.   if not RecyclerIsValid(tmp) then exit;
  1250.  
  1251.   fs := TFileStream.Create(tmp, fmOpenRead);
  1252.   try
  1253.     fs.seek(length_position, soFromBeginning);
  1254.     record_length := _readInt32(fs);
  1255.  
  1256.     if record_length <> $118 then
  1257.     begin
  1258.       // Windows NT
  1259.       i := -1;
  1260.       repeat
  1261.         inc(i);
  1262.         if unique_index_position+i*record_length > fs.size then break;
  1263.         fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1264.         if inttostr(_readInt32(fs)) = id then
  1265.         begin
  1266.           fs.seek(unicode_source_position+i*record_length, soFromBeginning);
  1267.           result := _readNullTerminatedWideString(fs);
  1268.           break;
  1269.         end;
  1270.       until false;
  1271.     end;
  1272.   finally
  1273.     fs.free;
  1274.   end;
  1275.  
  1276.   if record_length = $118 then
  1277.   begin
  1278.     // Windows 9x has no unicode support
  1279.     result := RecyclerGetSource(tmp, id);
  1280.   end;
  1281. end;
  1282.  
  1283. ////////////////////////////////////////////////////////////////////////////////
  1284.  
  1285. function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
  1286. begin
  1287.   result := RecyclerGetSource(InfofileOrRecycleFolder, '');
  1288. end;
  1289.  
  1290. function RecyclerGetSource(drive: char; fileid: string): string; overload;
  1291. begin
  1292.   result := RecyclerGetSource(drive, '', fileid);
  1293. end;
  1294.  
  1295. function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
  1296. var
  1297.   infofile: string;
  1298. begin
  1299.   infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1300.   result := RecyclerGetSource(infofile, fileid);
  1301. end;
  1302.  
  1303. function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
  1304. var
  1305.   fs: TFileStream;
  1306.   i, record_length: integer;
  1307.   tmp: string;
  1308.   alternativ: string;
  1309. const
  1310.   length_position = $C;
  1311.   unique_index_position = $118;
  1312.   source_position = $14;
  1313. begin
  1314.   result := '';
  1315.  
  1316.   tmp := InfofileOrRecycleFolder;
  1317.  
  1318.   if _isFileVistaNamed(tmp) then
  1319.   begin
  1320.     // Vista only gives unicode names
  1321.     result := _VistaGetSourceUnicode(tmp);
  1322.     exit;
  1323.   end;
  1324.  
  1325.   {$IFDEF allow_all_filenames}
  1326.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1327.   begin
  1328.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1329.       tmp := extractfilepath(tmp)+'INFO2'
  1330.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1331.       tmp := extractfilepath(tmp)+'INFO';
  1332.   end;
  1333.   {$ENDIF}
  1334.  
  1335.   if directoryexists(tmp) then
  1336.   begin
  1337.     tmp := IncludeTrailingBackslash(tmp);
  1338.  
  1339.     if fileexists(tmp+'$I'+id) then
  1340.     begin
  1341.       // Vista only gives unicode names
  1342.       result := _VistaGetSourceUnicode(tmp+'$I'+id);
  1343.       exit;
  1344.     end
  1345.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1346.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1347.   end;
  1348.  
  1349.   if not fileexists(tmp) then exit;
  1350.   if not RecyclerIsValid(tmp) then exit;
  1351.  
  1352.   fs := TFileStream.Create(tmp, fmOpenRead);
  1353.   try
  1354.     fs.seek(length_position, soFromBeginning);
  1355.     record_length := _readInt32(fs);
  1356.  
  1357.     i := -1;
  1358.     repeat
  1359.       inc(i);
  1360.       if unique_index_position+i*record_length > fs.size then break;
  1361.       fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1362.       if inttostr(_readInt32(fs)) = id then
  1363.       begin
  1364.         fs.seek(source_position+i*record_length, soFromBeginning);
  1365.         alternativ := _readChar(fs);
  1366.  
  1367.         if alternativ = #0 then
  1368.         begin
  1369.           fs.seek(source_position+i*record_length+1, soFromBeginning);
  1370.           result := _readNullTerminatedString(fs);
  1371.         end
  1372.         else
  1373.         begin
  1374.           fs.seek(source_position+i*record_length, soFromBeginning);
  1375.           result := _readNullTerminatedString(fs);
  1376.         end;
  1377.  
  1378.         break;
  1379.       end;
  1380.     until false;
  1381.   finally
  1382.     fs.free;
  1383.   end;
  1384.  
  1385.   // In some cases the ansi-source-name is [Null]:\...\
  1386.   if alternativ = #0 then
  1387.   begin
  1388.     result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, id) + result;
  1389.   end;
  1390. end;
  1391.  
  1392. ////////////////////////////////////////////////////////////////////////////////
  1393.  
  1394. procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
  1395. begin
  1396.   RecyclerListIndexes(drive, '', result);
  1397. end;
  1398.  
  1399. procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
  1400. var
  1401.   infofile: string;
  1402. begin
  1403.   infofile := RecyclerGetPath(drive, UserSID, false);
  1404.   RecyclerListIndexes(infofile, result);
  1405. end;
  1406.  
  1407. procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
  1408. var
  1409.   fs: TFileStream;
  1410.   i, record_length: integer;
  1411.   tmp: string;
  1412. const
  1413.   length_position = $C;
  1414.   unique_index_position = $118;
  1415. begin
  1416.   tmp := InfofileOrRecycleFolder;
  1417.  
  1418.   if _isFileVistaNamed(tmp) then
  1419.   begin
  1420.     _VistaListIndexes(extractfilepath(tmp), result);
  1421.     exit;
  1422.   end;
  1423.  
  1424.   {$IFDEF allow_all_filenames}
  1425.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1426.   begin
  1427.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1428.       tmp := extractfilepath(tmp)+'INFO2'
  1429.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1430.       tmp := extractfilepath(tmp)+'INFO';
  1431.   end;
  1432.   {$ENDIF}
  1433.  
  1434.   if directoryexists(tmp) then
  1435.   begin
  1436.     tmp := IncludeTrailingBackslash(tmp);
  1437.  
  1438.     if fileexists(tmp+'INFO2') then     tmp := tmp+'INFO2'
  1439.     else if fileexists(tmp+'INFO') then tmp := tmp+'INFO'
  1440.     else
  1441.     begin
  1442.       // Last try: is it a vista-directory?
  1443.       _VistaListIndexes(tmp, result);
  1444.       exit;
  1445.     end;
  1446.   end;
  1447.  
  1448.   if not fileexists(tmp) then exit;
  1449.   if not RecyclerIsValid(tmp) then exit;
  1450.  
  1451.   fs := TFileStream.Create(tmp, fmOpenRead);
  1452.   try
  1453.     fs.seek(length_position, soFromBeginning);
  1454.     record_length := _readInt32(fs);
  1455.  
  1456.     i := -1;
  1457.     repeat
  1458.       inc(i);
  1459.       if unique_index_position+i*record_length > fs.size then break;
  1460.       fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1461.  
  1462.       result.Add(inttostr(_readInt32(fs)));
  1463.     until false;
  1464.   finally
  1465.     fs.free;
  1466.   end;
  1467. end;
  1468.  
  1469. ////////////////////////////////////////////////////////////////////////////////
  1470.  
  1471. function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
  1472. begin
  1473.   result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, '');
  1474. end;
  1475.  
  1476. function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
  1477. begin
  1478.   result := RecyclerGetSourceDrive(drive, '', fileid);
  1479. end;
  1480.  
  1481. function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
  1482. var
  1483.   infofile: string;
  1484. begin
  1485.   infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1486.   result := RecyclerGetSourceDrive(infofile, fileid);
  1487. end;
  1488.  
  1489. function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
  1490. var
  1491.   fs: TFileStream;
  1492.   i, record_length: integer;
  1493.   tmp: string;
  1494. const
  1495.   length_position = $C;
  1496.   unique_index_position = $118;
  1497.   source_drive_position = $11C;
  1498. begin
  1499.   result := #0;
  1500.  
  1501.   tmp := InfofileOrRecycleFolder;
  1502.  
  1503.   if _isFileVistaNamed(tmp) then
  1504.   begin
  1505.     result := _VistaGetSourceDrive(tmp);
  1506.     exit;
  1507.   end;
  1508.  
  1509.   {$IFDEF allow_all_filenames}
  1510.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1511.   begin
  1512.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1513.       tmp := extractfilepath(tmp)+'INFO2'
  1514.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1515.       tmp := extractfilepath(tmp)+'INFO';
  1516.   end;
  1517.   {$ENDIF}
  1518.  
  1519.   if directoryexists(tmp) then
  1520.   begin
  1521.     tmp := IncludeTrailingBackslash(tmp);
  1522.  
  1523.     if fileexists(tmp+'$I'+id) then
  1524.     begin
  1525.       result := _VistaGetSourceDrive(tmp+'$I'+id);
  1526.       exit;
  1527.     end
  1528.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1529.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1530.   end;
  1531.  
  1532.   if not fileexists(tmp) then exit;
  1533.   if not RecyclerIsValid(tmp) then exit;
  1534.  
  1535.   fs := TFileStream.Create(tmp, fmOpenRead);
  1536.   try
  1537.     fs.seek(length_position, soFromBeginning);
  1538.     record_length := _readInt32(fs);
  1539.  
  1540.     i := -1;
  1541.     repeat
  1542.       inc(i);
  1543.       if unique_index_position+i*record_length > fs.size then break;
  1544.       fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1545.       if inttostr(_readInt32(fs)) = id then
  1546.       begin
  1547.         fs.seek(source_drive_position+i*record_length, soFromBeginning);
  1548.         result := chr(ord('A') + _readInt8(fs));
  1549.         break;
  1550.       end;
  1551.     until false;
  1552.   finally
  1553.     fs.free;
  1554.   end;
  1555. end;
  1556.  
  1557. ////////////////////////////////////////////////////////////////////////////////
  1558.  
  1559. function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
  1560. begin
  1561.   result := RecyclerOriginalSize(InfofileOrRecycleFolder, '');
  1562. end;
  1563.  
  1564. function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
  1565. begin
  1566.   result := RecyclerOriginalSize(drive, '', fileid);
  1567. end;
  1568.  
  1569. function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
  1570. var
  1571.   infofile: string;
  1572. begin
  1573.   infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1574.   result := RecyclerOriginalSize(infofile, fileid);
  1575. end;
  1576.  
  1577. function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
  1578. var
  1579.   fs: TFileStream;
  1580.   i, record_length: integer;
  1581.   tmp: string;
  1582. const
  1583.   length_position = $C;
  1584.   unique_index_position = $118;
  1585.   original_size_position = $128;
  1586. begin
  1587.   result := -1;
  1588.  
  1589.   tmp := InfofileOrRecycleFolder;
  1590.  
  1591.   if _isFileVistaNamed(tmp) then
  1592.   begin
  1593.     result := _VistaOriginalSize(tmp);
  1594.     exit;
  1595.   end;
  1596.  
  1597.   {$IFDEF allow_all_filenames}
  1598.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1599.   begin
  1600.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1601.       tmp := extractfilepath(tmp)+'INFO2'
  1602.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1603.       tmp := extractfilepath(tmp)+'INFO';
  1604.   end;
  1605.   {$ENDIF}
  1606.  
  1607.   if directoryexists(tmp) then
  1608.   begin
  1609.     tmp := IncludeTrailingBackslash(tmp);
  1610.  
  1611.     if fileexists(tmp+'$I'+id) then
  1612.     begin
  1613.       result := _VistaOriginalSize(tmp+'$I'+id);
  1614.       exit;
  1615.     end
  1616.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1617.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1618.   end;
  1619.  
  1620.   if not fileexists(tmp) then exit;
  1621.   if not RecyclerIsValid(tmp) then exit;
  1622.  
  1623.   fs := TFileStream.Create(tmp, fmOpenRead);
  1624.   try
  1625.     fs.seek(length_position, soFromBeginning);
  1626.     record_length := _readInt32(fs);
  1627.  
  1628.     i := -1;
  1629.     repeat
  1630.       inc(i);
  1631.       if unique_index_position+i*record_length > fs.size then break;
  1632.       fs.seek(unique_index_position+i*record_length, soFromBeginning);
  1633.       if inttostr(_readInt32(fs)) = id then
  1634.       begin
  1635.         fs.seek(original_size_position+i*record_length, soFromBeginning);
  1636.         result := _readInt32(fs);
  1637.         break;
  1638.       end;
  1639.     until false;
  1640.   finally
  1641.     fs.free;
  1642.   end;
  1643. end;
  1644.  
  1645. ////////////////////////////////////////////////////////////////////////////////
  1646.  
  1647. function RecyclerIsValid(drive: char): boolean; overload;
  1648. begin
  1649.   // Bei Vista und Win2003 (VM) erhalte ich bei LW A: die Meldung
  1650.   // "c0000013 Kein Datenträger". Exception Abfangen geht nicht.
  1651.   // Daher erstmal überprüfen, ob Laufwerk existiert.
  1652.   result := false;
  1653.   if not RecyclerIsPossible(drive) then exit;
  1654.  
  1655.   result := RecyclerIsValid(drive, '');
  1656. end;
  1657.  
  1658. function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
  1659. var
  1660.   infofile: string;
  1661. begin
  1662.   // Anmerkung siehe oben.
  1663.   result := false;
  1664.   if not RecyclerIsPossible(drive) then exit;
  1665.  
  1666.   infofile := RecyclerGetPath(drive, UserSID, false);
  1667.   result := RecyclerIsValid(infofile);
  1668. end;
  1669.  
  1670. function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
  1671. var
  1672.   tmp: string;
  1673.   x: TStringList;
  1674.   i: integer;
  1675.   eine_fehlerhaft: boolean;
  1676. begin
  1677.   result := false;
  1678.  
  1679.   tmp := InfofileOrRecycleFolder;
  1680.  
  1681.   if _isFileVistaNamed(tmp) then
  1682.   begin
  1683.     result := _VistaIsValid(tmp);
  1684.     exit;
  1685.   end;
  1686.  
  1687.   {$IFDEF allow_all_filenames}
  1688.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1689.   begin
  1690.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1691.       tmp := extractfilepath(tmp)+'INFO2'
  1692.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1693.       tmp := extractfilepath(tmp)+'INFO';
  1694.   end;
  1695.   {$ENDIF}
  1696.  
  1697.   if directoryexists(tmp) then
  1698.   begin
  1699.     tmp := IncludeTrailingBackslash(tmp);
  1700.  
  1701.     if fileexists(tmp+'INFO2') then
  1702.     begin
  1703.       result := _checkInfo1or2File(tmp+'INFO2');
  1704.     end;
  1705.  
  1706.     if not result and fileexists(tmp+'INFO') then
  1707.     begin
  1708.       result := _checkInfo1or2File(tmp+'INFO');
  1709.     end;
  1710.  
  1711.     if not result then
  1712.     begin
  1713.       // Complete vista-directory declared?
  1714.       eine_fehlerhaft := false;
  1715.       x := TStringList.Create;
  1716.       try
  1717.         _VistaListIndexes(tmp, x);
  1718.         for i := 0 to x.Count - 1 do
  1719.         begin
  1720.           if not _VistaIsValid(tmp+'$I'+x.Strings[i]) then
  1721.           begin
  1722.             eine_fehlerhaft := true;
  1723.           end;
  1724.         end;
  1725.       finally
  1726.         x.Free;
  1727.       end;
  1728.       result := not eine_fehlerhaft;
  1729.     end;
  1730.   end;
  1731.  
  1732.   if not fileexists(tmp) then exit;
  1733.  
  1734.   result := _checkInfo1or2File(tmp);
  1735. end;
  1736.  
  1737. ////////////////////////////////////////////////////////////////////////////////
  1738.  
  1739. function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
  1740. begin
  1741.   result := RecyclerCurrentFilename(InfofileOrRecycleFolder, '');
  1742. end;
  1743.  
  1744. function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
  1745. begin
  1746.   result := RecyclerCurrentFilename(drive, '', fileid);
  1747. end;
  1748.  
  1749. function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
  1750. var
  1751.   infofile: string;
  1752. begin
  1753.   infofile := RecyclerGetPath(drive, UserSID, true, fileid);
  1754.   result := RecyclerCurrentFilename(infofile, fileid);
  1755. end;
  1756.  
  1757. function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
  1758. var
  1759.   a, c: string;
  1760.   tmp: string;
  1761. begin
  1762.   result := '';
  1763.  
  1764.   tmp := InfofileOrRecycleFolder;
  1765.  
  1766.   if _isFileVistaNamed(tmp) then
  1767.   begin
  1768.     result := _VistaCurrentFilename(tmp);
  1769.     exit;
  1770.   end;
  1771.  
  1772.   {$IFDEF allow_all_filenames}
  1773.   if not RecyclerIsValid(tmp) and fileexists(tmp) then
  1774.   begin
  1775.     if fileexists(extractfilepath(tmp)+'INFO2') then
  1776.       tmp := extractfilepath(tmp)+'INFO2'
  1777.     else if fileexists(extractfilepath(tmp)+'INFO') then
  1778.       tmp := extractfilepath(tmp)+'INFO';
  1779.   end;
  1780.   {$ENDIF}
  1781.  
  1782.   if directoryexists(tmp) then
  1783.   begin
  1784.     tmp := IncludeTrailingBackslash(tmp);
  1785.  
  1786.     if fileexists(tmp+'$I'+id) then
  1787.     begin
  1788.       result := _VistaCurrentFilename(tmp+'$I'+id);
  1789.       exit;
  1790.     end
  1791.     else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
  1792.     else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
  1793.   end;
  1794.  
  1795.   a := RecyclerGetSourceDrive(tmp, id);
  1796.   c := extractfileext(RecyclerGetSourceUnicode(tmp, id));
  1797.   if (a <> '') then
  1798.   begin
  1799.     result := 'D' + a + id + c;
  1800.   end;
  1801. end;
  1802.  
  1803. ////////////////////////////////////////////////////////////////////////////////
  1804.  
  1805. function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
  1806. var
  1807.   sl: TStringList;
  1808. begin
  1809.   sl := TStringList.Create;
  1810.   try
  1811.     RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, fileid, sl);
  1812.     if sl.Count > 0 then
  1813.       result := ExtractFilePath(sl.Strings[0])
  1814.     else
  1815.       result := '';
  1816.   finally
  1817.     sl.free;
  1818.   end;
  1819. end;
  1820.  
  1821. function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
  1822. var
  1823.   sl: TStringList;
  1824. begin
  1825.   sl := TStringList.Create;
  1826.   try
  1827.     RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, sl);
  1828.     if sl.Count > 0 then
  1829.       result := ExtractFilePath(sl.Strings[0])
  1830.     else
  1831.       result := '';
  1832.   finally
  1833.     sl.free;
  1834.   end;
  1835. end;
  1836.  
  1837. function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
  1838. var
  1839.   sl: TStringList;
  1840. begin
  1841.   sl := TStringList.Create;
  1842.   try
  1843.     RecyclerGetInfofiles(drive, IncludeInfofile, sl);
  1844.     if sl.Count > 0 then
  1845.       result := ExtractFilePath(sl.Strings[0])
  1846.     else
  1847.       result := '';
  1848.   finally
  1849.     sl.free;
  1850.   end;
  1851. end;
  1852.  
  1853. function RecyclerGetPath(drive: char; UserSID: string): string; overload;
  1854. var
  1855.   sl: TStringList;
  1856. begin
  1857.   sl := TStringList.Create;
  1858.   try
  1859.     RecyclerGetInfofiles(drive, UserSID, sl);
  1860.     if sl.Count > 0 then
  1861.       result := ExtractFilePath(sl.Strings[0])
  1862.     else
  1863.       result := '';
  1864.   finally
  1865.     sl.free;
  1866.   end;
  1867. end;
  1868.  
  1869. function RecyclerGetPath(drive: char): string; overload;
  1870. var
  1871.   sl: TStringList;
  1872. begin
  1873.   sl := TStringList.Create;
  1874.   try
  1875.     RecyclerGetInfofiles(drive, sl);
  1876.     if sl.Count > 0 then
  1877.       result := ExtractFilePath(sl.Strings[0])
  1878.     else
  1879.       result := '';
  1880.   finally
  1881.     sl.free;
  1882.   end;
  1883. end;
  1884.  
  1885. ////////////////////////////////////////////////////////////////////////////////
  1886.  
  1887. procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
  1888. var
  1889.   dir: string;
  1890. begin
  1891.   // Find recyclers from Windows Vista or higher
  1892.  
  1893.   if _isFAT(drive) then
  1894.   begin
  1895.     dir := drive + DriveDelim + PathDelim + '$recycle.bin' + PathDelim;
  1896.     if IncludeInfofile and (fileid <> '') then
  1897.     begin
  1898.       if fileExists(dir + '$I'+fileid) then
  1899.       begin
  1900.         result.Add(dir + '$I'+fileid);
  1901.       end;
  1902.     end
  1903.     else
  1904.     begin
  1905.       if directoryExists(dir) then
  1906.       begin
  1907.         result.Add(dir);
  1908.       end;
  1909.     end;
  1910.   end
  1911.   else
  1912.   begin
  1913.     if UserSID <> '' then
  1914.     begin
  1915.       dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+UserSID+PathDelim;
  1916.       if IncludeInfofile and (fileid <> '') then
  1917.       begin
  1918.         if fileExists(dir + '$I'+fileid) then
  1919.         begin
  1920.           result.Add(dir + '$I'+fileid);
  1921.         end;
  1922.       end
  1923.       else
  1924.       begin
  1925.         if directoryExists(dir) then
  1926.         begin
  1927.           result.Add(dir);
  1928.         end;
  1929.       end;
  1930.     end
  1931.     else
  1932.     begin
  1933.       // TODO: aber vielleicht möchte man die Papierkörbe aller Benutzer (also aller SIDs) finden!!!
  1934.       dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+_getMySID()+PathDelim;
  1935.       if IncludeInfofile and (fileid <> '') then
  1936.       begin
  1937.         if fileExists(dir + '$I'+fileid) then
  1938.         begin
  1939.           result.Add(dir + '$I'+fileid);
  1940.         end;
  1941.       end
  1942.       else
  1943.       begin
  1944.         if directoryExists(dir) then
  1945.         begin
  1946.           result.Add(dir);
  1947.         end;
  1948.       end;
  1949.     end;
  1950.   end;
  1951.  
  1952.   // Find recyclers from Windows before Vista
  1953.  
  1954.   if _isFAT(drive) then
  1955.   begin
  1956.     dir := drive + DriveDelim + PathDelim + 'Recycled' + PathDelim;
  1957.     if IncludeInfofile then
  1958.     begin
  1959.       // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them)
  1960.       if fileExists(dir + 'INFO2') then
  1961.         result.Add(dir + 'INFO2'); // Windows 95 with Internet Explorer 4 Extension or higher Windows versions
  1962.       if fileExists(dir + 'INFO') then
  1963.         result.Add(dir + 'INFO'); // Windows 95 native
  1964.     end
  1965.     else
  1966.     begin
  1967.       if directoryExists(dir) then
  1968.         result.Add(dir);
  1969.     end;
  1970.   end
  1971.   else
  1972.   begin
  1973.     if UserSID <> '' then
  1974.     begin
  1975.       dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+UserSID+PathDelim;
  1976.       if IncludeInfofile then
  1977.       begin
  1978.         if fileExists(dir + 'INFO2') then
  1979.           result.Add(dir + 'INFO2');
  1980.         if fileExists(dir + 'INFO') then
  1981.           result.Add(dir + 'INFO'); // Windows NT 4
  1982.       end
  1983.       else
  1984.       begin
  1985.         if directoryExists(dir) then
  1986.           result.Add(dir);
  1987.       end;
  1988.     end
  1989.     else
  1990.     begin
  1991.       dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+_getMySID()+PathDelim;
  1992.       if IncludeInfofile then
  1993.       begin
  1994.         if fileExists(dir + 'INFO2') then
  1995.           result.Add(dir + 'INFO2');
  1996.         if fileExists(dir + 'INFO') then
  1997.           result.Add(dir + 'INFO'); // Windows NT 4
  1998.       end
  1999.       else
  2000.       begin
  2001.         if directoryExists(dir) then
  2002.           result.Add(dir);
  2003.       end;
  2004.     end;
  2005.   end;
  2006. end;
  2007.  
  2008. procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
  2009. begin
  2010.   RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, '', result);
  2011. end;
  2012.  
  2013. procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
  2014. begin
  2015.   RecyclerGetInfofiles(drive, '', IncludeInfofile, '', result);
  2016. end;
  2017.  
  2018. procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
  2019. begin
  2020.   RecyclerGetInfofiles(drive, UserSID, false, '', result);
  2021. end;
  2022.  
  2023. procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
  2024. begin
  2025.   RecyclerGetInfofiles(drive, '', false, '', result);
  2026. end;
  2027.  
  2028. ////////////////////////////////////////////////////////////////////////////////
  2029.  
  2030. function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
  2031. begin
  2032.   result := RecyclerGetPath(drive, UserSID, false, fileid) +
  2033.     RecyclerCurrentFilename(drive, UserSID, fileid);
  2034. end;
  2035.  
  2036. function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
  2037. begin
  2038.   result := RecyclerCurrentFilenameAndPath(drive, '', fileid);
  2039. end;
  2040.  
  2041. function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
  2042. begin
  2043.   if RecyclerIsValid(InfofileOrRecycleFolder) then
  2044.   begin
  2045.     result := extractfilepath(InfofileOrRecycleFolder) +
  2046.       RecyclerCurrentFilename(InfofileOrRecycleFolder, id);
  2047.   end
  2048.   else
  2049.     result := '';
  2050. end;
  2051.  
  2052. ////////////////////////////////////////////////////////////////////////////////
  2053.  
  2054. function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
  2055. var
  2056.   tmp: string;
  2057. begin
  2058.   tmp := RecyclerCurrentFilenameAndPath(drive, UserSID, fileid);
  2059.   if fileexists(tmp) then
  2060.   begin
  2061.     deletefile(tmp);
  2062.     result := fileexists(tmp);
  2063.   end
  2064.   else
  2065.   begin
  2066.     directoryexists(tmp);
  2067.     result := directoryexists(tmp);
  2068.   end;
  2069. end;
  2070.  
  2071. function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
  2072. begin
  2073.   result := RecyclerRemoveItem(drive, '', fileid);
  2074. end;
  2075.  
  2076. function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
  2077. var
  2078.   tmp: string;
  2079. begin
  2080.   tmp := RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder, id);
  2081.   if fileexists(tmp) then
  2082.   begin
  2083.     deletefile(tmp);
  2084.     result := fileexists(tmp);
  2085.   end
  2086.   else
  2087.   begin
  2088.     _DeleteDirectory(tmp);
  2089.     result := directoryexists(tmp);
  2090.   end;
  2091. end;
  2092.  
  2093. procedure RecyclerGetAllRecyclerDrives(result: TStringList);
  2094. var
  2095.   Drive: char;
  2096. begin
  2097.   for Drive := 'A' to 'Z' do
  2098.   begin
  2099.     if RecyclerIsPossible(Drive) and RecyclerIsValid(Drive) then
  2100.     begin
  2101.       result.Add(Drive);
  2102.     end;
  2103.   end;
  2104. end;
  2105.  
  2106. ////////////////////////////////////////////////////////////////////////////////
  2107.  
  2108. // http://www.dsdt.info/tipps/?id=176
  2109. function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
  2110. type
  2111.   TSHEmptyRecycleBin = function (Wnd: HWND;
  2112.                                  pszRootPath: PChar;
  2113.                                  dwFlags: DWORD):
  2114.                                  HRESULT; stdcall;
  2115. var
  2116.   PSHEmptyRecycleBin: TSHEmptyRecycleBin;
  2117.   LibHandle: THandle;
  2118. const
  2119.   C_SHEmptyRecycleBinA = 'SHEmptyRecycleBinA';
  2120. begin
  2121.   result := true;
  2122.   LibHandle := LoadLibrary(shell32) ;
  2123.   try
  2124.     if LibHandle <> 0 then
  2125.     begin
  2126.       @PSHEmptyRecycleBin:= GetProcAddress(LibHandle, C_SHEmptyRecycleBinA);
  2127.       if @PSHEmptyRecycleBin <> nil then
  2128.       begin
  2129.         PSHEmptyRecycleBin(hInstance, nil, flags);
  2130.       end
  2131.       else
  2132.         result := false;
  2133.     end
  2134.     else
  2135.       result := false;
  2136.   finally
  2137.     @PSHEmptyRecycleBin := nil;
  2138.     FreeLibrary(LibHandle);
  2139.   end;
  2140. end;
  2141.  
  2142. function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
  2143. const
  2144.   SHERB_NOCONFIRMATION = $00000001;
  2145.   SHERB_NOPROGRESSUI   = $00000002;
  2146.   SHERB_NOSOUND        = $00000004;
  2147. var
  2148.   flags: cardinal;
  2149. begin
  2150.   flags := 0;
  2151.  
  2152.   if not progress then
  2153.     flags := flags or SHERB_NOPROGRESSUI;
  2154.   if not confirmation then
  2155.     flags := flags or SHERB_NOCONFIRMATION;
  2156.   if not sound then
  2157.     flags := flags or SHERB_NOSOUND;
  2158.  
  2159.   result := RecyclerEmptyRecycleBin(flags);
  2160. end;
  2161.  
  2162. ////////////////////////////////////////////////////////////////////////////////
  2163.  
  2164. // Template
  2165. // http://www.dsdt.info/tipps/?id=116
  2166. function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
  2167. var
  2168.   Operation: TSHFileOpStruct;
  2169. begin
  2170.   with Operation do
  2171.   begin
  2172.     Wnd := hInstance; // OK?
  2173.     wFunc := FO_DELETE;
  2174.     pFrom := PChar(FileOrFolder + #0);
  2175.     pTo := nil;
  2176.     fFlags := FOF_ALLOWUNDO;
  2177.     if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
  2178.   end;
  2179.   Result := SHFileOperation(Operation) = 0;
  2180. end;
  2181.  
  2182. function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
  2183. begin
  2184.   result := RecyclerAddFileOrFolder(FileOrFolder, false);
  2185. end;
  2186.  
  2187. function RecyclerConfirmationDialogEnabled: boolean;
  2188. var
  2189.   gp: GPOLICYBOOL;
  2190. begin
  2191.   gp := RecyclerGroupPolicyConfirmFileDelete;
  2192.   if gp <> gpUndefined then
  2193.   begin
  2194.     result := gp = gpEnabled;
  2195.   end
  2196.   else
  2197.   begin
  2198.     result := RecyclerShellStateConfirmationDialogEnabled;
  2199.   end;
  2200. end;
  2201.  
  2202. function RecyclerShellStateConfirmationDialogEnabled: boolean;
  2203. type
  2204.   TSHGetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD) stdcall;
  2205. const
  2206.   C_SHGetSettings = 'SHGetSettings';
  2207. var
  2208.   lpss: SHELLSTATE;
  2209.   bNoConfirmRecycle: boolean;
  2210.  
  2211.   PSHGetSettings: TSHGetSettings;
  2212.   RBHandle: THandle;
  2213.  
  2214.   reg: TRegistry;
  2215.   rbuf: array[0..255] of byte;
  2216. begin
  2217.   PSHGetSettings := nil;
  2218.   result := false; // Avoid warning message
  2219.  
  2220.   RBHandle := LoadLibrary(shell32);
  2221.   if(RBHandle <> 0) then
  2222.   begin
  2223.     PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings);
  2224.     if (@PSHGetSettings = nil) then
  2225.     begin
  2226.       FreeLibrary(RBHandle);
  2227.       RBHandle := 0;
  2228.     end;
  2229.   end;
  2230.  
  2231.   if (RBHandle <> 0) and (Assigned(PSHGetSettings)) then
  2232.   begin
  2233.     ZeroMemory(@lpss, SizeOf(lpss));
  2234.     PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE);
  2235.     // bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle
  2236.     bNoConfirmRecycle := GetByteBit(lpss.Flags1, 2);
  2237.  
  2238.     result := not bNoConfirmRecycle;
  2239.   end
  2240.   else
  2241.   begin
  2242.     reg := TRegistry.Create;
  2243.     try
  2244.       // API function call failed. Probably because Windows is too old.
  2245.       // Try to read out from registry.
  2246.       // The 3rd bit of the 5th byte of "ShellState" is the value
  2247.       // of "fNoConfirmRecycle".
  2248.  
  2249.       reg.RootKey := HKEY_CURRENT_USER;
  2250.       if (reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer')) then
  2251.       begin
  2252.         ZeroMemory(@rbuf, SizeOf(rbuf));
  2253.         reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf));
  2254.  
  2255.         // Lese 3tes Bit vom 5ten Byte
  2256.         // bNoConfirmRecycle := ((rbuf[4] and 4) = 4);
  2257.         bNoConfirmRecycle := GetByteBit(rbuf[4], 2);
  2258.         result := not bNoConfirmRecycle;
  2259.  
  2260.         reg.CloseKey;
  2261.       end
  2262.       else
  2263.       begin
  2264.         raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]);
  2265.       end;
  2266.     finally
  2267.       reg.Free;
  2268.     end;
  2269.   end;
  2270.  
  2271.   if (RBHandle <> 0) then FreeLibrary(RBHandle);
  2272. end;
  2273.  
  2274. procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
  2275. type
  2276.   TSHGetSetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL) stdcall;
  2277. const
  2278.   C_SHGetSetSettings = 'SHGetSetSettings';
  2279. var
  2280.   lpss: SHELLSTATE;
  2281.  
  2282.   PSHGetSetSettings: TSHGetSetSettings;
  2283.   RBHandle: THandle;
  2284.  
  2285.   reg: TRegistry;
  2286.   rbuf: array[0..255] of byte;
  2287.  
  2288.   //dwResult: DWORD;
  2289.   lpdwResult: PDWORD_PTR;
  2290. begin
  2291.   PSHGetSetSettings := nil;
  2292.   lpdwResult := nil;
  2293.  
  2294.   RBHandle := LoadLibrary(shell32);
  2295.   if(RBHandle <> 0) then
  2296.   begin
  2297.     PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
  2298.     if (@PSHGetSetSettings = nil) then
  2299.     begin
  2300.       FreeLibrary(RBHandle);
  2301.       RBHandle := 0;
  2302.     end;
  2303.   end;
  2304.  
  2305.   if (RBHandle <> 0) and (Assigned(PSHGetSetSettings)) then
  2306.   begin
  2307.     ZeroMemory(@lpss, SizeOf(lpss));
  2308.     PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get
  2309.     lpss.Flags1 := SetByteBit(lpss.Flags1, 2, NewSetting);
  2310.     PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
  2311.  
  2312.     SendMessageTimeout (
  2313.       HWND_BROADCAST, WM_SETTINGCHANGE,
  2314.       0, lParam (pChar ('ShellState')),
  2315.       SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2316.     );
  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.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false)) then
  2329.       begin
  2330.         ZeroMemory(@rbuf, SizeOf(rbuf));
  2331.         reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get
  2332.         rbuf[4] := SetByteBit(rbuf[4], 2, NewSetting);
  2333.         reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
  2334.  
  2335.         SendMessageTimeout (
  2336.           HWND_BROADCAST, WM_SETTINGCHANGE,
  2337.           0, lParam (pChar ('ShellState')),
  2338.           SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
  2339.         );
  2340.  
  2341.         reg.CloseKey;
  2342.       end
  2343.       else
  2344.       begin
  2345.         raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSetSettings])]);
  2346.       end;
  2347.     finally
  2348.       reg.Free;
  2349.     end;
  2350.   end;
  2351.  
  2352.   if (RBHandle <> 0) then FreeLibrary(RBHandle);
  2353. end;
  2354.  
  2355. function RecyclerGetCurrentIconString: string;
  2356. begin
  2357.   if RecyclerIsEmpty then
  2358.     result := RecyclerGetEmptyIconString
  2359.   else
  2360.     result := RecyclerGetFullIconString;
  2361. end;
  2362.  
  2363. function RecyclerGetDefaultIconString: string;
  2364. var
  2365.   reg: TRegistry;
  2366. begin
  2367.   // Please note: The "default" icon is not always the icon of the
  2368.   // current recycle bin in its current state (full, empty)
  2369.   // At Windows 95b, the registry value actually did change every time the
  2370.   // recycle bin state did change, but at Windows 2000 I could not see any
  2371.   // update, even after reboot. So, the registry value is possible fixed as
  2372.   // default = empty on newer OS versions.
  2373.  
  2374.   reg := TRegistry.Create;
  2375.   try
  2376.     reg.RootKey := HKEY_CLASSES_ROOT;
  2377.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
  2378.     begin
  2379.       result := reg.ReadString('');
  2380.       reg.CloseKey;
  2381.     end;
  2382.   finally
  2383.     reg.Free;
  2384.   end;
  2385. end;
  2386.  
  2387. function RecyclerGetEmptyIconString: string;
  2388. var
  2389.   reg: TRegistry;
  2390. begin
  2391.   reg := TRegistry.Create;
  2392.   try
  2393.     reg.RootKey := HKEY_CLASSES_ROOT;
  2394.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
  2395.     begin
  2396.       result := reg.ReadString('Empty');
  2397.       reg.CloseKey;
  2398.     end;
  2399.   finally
  2400.     reg.Free;
  2401.   end;
  2402. end;
  2403.  
  2404. function RecyclerGetFullIconString: string;
  2405. var
  2406.   reg: TRegistry;
  2407. begin
  2408.   reg := TRegistry.Create;
  2409.   try
  2410.     reg.RootKey := HKEY_CLASSES_ROOT;
  2411.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID+'\DefaultIcon') then
  2412.     begin
  2413.       result := reg.ReadString('Full');
  2414.       reg.CloseKey;
  2415.     end;
  2416.   finally
  2417.     reg.Free;
  2418.   end;
  2419. end;
  2420.  
  2421. function RecyclerGetName: string;
  2422. var
  2423.   reg: TRegistry;
  2424. begin
  2425.   // Windows 95b:
  2426.   // Change of CLSID\{645FF040-5081-101B-9F08-00AA002F954E} will change the desktop name of the recycle bin.
  2427.  
  2428.   // Windows 2000: If LocalizedString is available, the 3rd argument will be parsed
  2429.   // (if the third argument will removed, it will be read out from the DLL resource string automatically)
  2430.  
  2431.   reg := TRegistry.Create;
  2432.   try
  2433.     reg.RootKey := HKEY_CLASSES_ROOT;
  2434.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
  2435.     begin
  2436.       if reg.ValueExists('LocalizedString') then
  2437.       begin
  2438.         result := reg.ReadString('LocalizedString');
  2439.         result := _DecodeReferenceString(result);
  2440.       end
  2441.       else
  2442.       begin
  2443.         result := reg.ReadString('');
  2444.       end;
  2445.  
  2446.       reg.CloseKey;
  2447.     end;
  2448.   finally
  2449.     reg.Free;
  2450.   end;
  2451. end;
  2452.  
  2453. function RecyclerGetInfoTip: string;
  2454. var
  2455.   reg: TRegistry;
  2456. begin
  2457.   // Not available in some older versions of Windows
  2458.  
  2459.   reg := TRegistry.Create;
  2460.   try
  2461.     reg.RootKey := HKEY_CLASSES_ROOT;
  2462.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
  2463.     begin
  2464.       result := reg.ReadString('InfoTip');
  2465.       result := _DecodeReferenceString(result);
  2466.  
  2467.       reg.CloseKey;
  2468.     end;
  2469.   finally
  2470.     reg.Free;
  2471.   end;
  2472. end;
  2473.  
  2474. function RecyclerGetIntroText: string;
  2475. var
  2476.   reg: TRegistry;
  2477. begin
  2478.   // Not available in some older versions of Windows
  2479.  
  2480.   reg := TRegistry.Create;
  2481.   try
  2482.     reg.RootKey := HKEY_CLASSES_ROOT;
  2483.     if reg.OpenKeyReadOnly('CLSID\'+RECYCLER_CLSID) then
  2484.     begin
  2485.       result := reg.ReadString('IntroText');
  2486.       result := _DecodeReferenceString(result);
  2487.  
  2488.       reg.CloseKey;
  2489.     end;
  2490.   finally
  2491.     reg.Free;
  2492.   end;
  2493. end;
  2494.  
  2495. function RecyclerEmptyEventGetName: string;
  2496. var
  2497.   reg: TRegistry;
  2498. begin
  2499.   reg := TRegistry.Create;
  2500.   try
  2501.     reg.RootKey := HKEY_CURRENT_USER;
  2502.     if reg.OpenKeyReadOnly('AppEvents\EventLabels\EmptyRecycleBin') then
  2503.     begin
  2504.       result := reg.ReadString('');
  2505.       reg.CloseKey;
  2506.     end;
  2507.   finally
  2508.     reg.Free;
  2509.   end;
  2510. end;
  2511.  
  2512. function RecyclerEmptyEventGetCurrentSound: string;
  2513. begin
  2514.   result := RecyclerEmptyEventGetSound('.Current');
  2515. end;
  2516.  
  2517. function RecyclerEmptyEventGetDefaultSound: string;
  2518. begin
  2519.   result := RecyclerEmptyEventGetSound('.Default');
  2520. end;
  2521.  
  2522. procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
  2523. var
  2524.   reg: TRegistry;
  2525. begin
  2526.   reg := TRegistry.Create;
  2527.   try
  2528.     reg.RootKey := HKEY_CURRENT_USER;
  2529.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2530.     begin
  2531.       reg.GetKeyNames(AStringList);
  2532.       reg.CloseKey;
  2533.     end;
  2534.   finally
  2535.     reg.Free;
  2536.   end;
  2537. end;
  2538.  
  2539. function RecyclerEmptyEventGetSound(ACategory: string): string;
  2540. var
  2541.   reg: TRegistry;
  2542. resourcestring
  2543.   LNG_SND_EVENT_CAT_ERROR = 'The category "%s" is not available for the notification event "%s".';
  2544. begin
  2545.   // Outputs an filename or empty string for no sound defined.
  2546.  
  2547.   reg := TRegistry.Create;
  2548.   try
  2549.     reg.RootKey := HKEY_CURRENT_USER;
  2550.     if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then
  2551.     begin
  2552.       if reg.OpenKeyReadOnly(ACategory) then
  2553.       begin
  2554.         result := reg.ReadString('');
  2555.         reg.CloseKey;
  2556.       end
  2557.       else
  2558.         raise EEventCategoryNotDefined.CreateFmt(LNG_SND_EVENT_CAT_ERROR, [ACategory, 'EmptyRecycleBin']);
  2559.       reg.CloseKey;
  2560.     end;
  2561.   finally
  2562.     reg.Free;
  2563.   end;
  2564. end;
  2565.  
  2566. function RecyclerGlobalGetPercentUsage: integer;
  2567. var
  2568.   reg: TRegistry;
  2569.   dump: string;
  2570. const
  2571.   RES_DEFAULT = 10;
  2572. begin
  2573.   result := -1;
  2574.  
  2575.   reg := TRegistry.Create;
  2576.   try
  2577.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2578.  
  2579.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  2580.     begin
  2581.       if reg.ValueExists('Percent') then
  2582.       begin
  2583.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  2584.  
  2585.         result := reg.ReadInteger('Percent');
  2586.       end
  2587.       else if reg.ValueExists('PurgeInfo') then
  2588.       begin
  2589.         // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
  2590.  
  2591.         dump := _registryReadDump(reg, 'PurgeInfo');
  2592.         result := Ord(dump[63]);
  2593.       end
  2594.       else
  2595.       begin
  2596.         // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
  2597.  
  2598.         result := RES_DEFAULT; // Standardeinstellung bei Windows
  2599.       end;
  2600.  
  2601.       reg.CloseKey;
  2602.     end;
  2603.   finally
  2604.     reg.Free;
  2605.   end;
  2606. end;
  2607.  
  2608. function RecyclerSpecificGetPercentUsage(Drive: Char): integer;
  2609. var
  2610.   reg: TRegistry;
  2611.   dump: string;
  2612. const
  2613.   RES_DEFAULT = 10;
  2614. begin
  2615.   result := -1;
  2616.  
  2617.   reg := TRegistry.Create;
  2618.   try
  2619.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2620.  
  2621.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  2622.     begin
  2623.       if reg.OpenKeyReadOnly(Drive) then
  2624.       begin
  2625.         if reg.ValueExists('Percent') then
  2626.         begin
  2627.           // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  2628.  
  2629.           result := reg.ReadInteger('Percent');
  2630.         end
  2631.         else
  2632.         begin
  2633.           result := RES_DEFAULT;
  2634.         end;
  2635.         reg.CloseKey;
  2636.       end
  2637.       else
  2638.       begin
  2639.         if reg.ValueExists('PurgeInfo') then
  2640.         begin
  2641.           // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
  2642.  
  2643.           dump := _registryReadDump(reg, 'PurgeInfo');
  2644.  
  2645.           // NOT tested, only theoretical! My idea about the possible structure is:
  2646.           // 0x08 = Drive A
  2647.           // 0x0a = Drive B
  2648.           // 0x0c = Drive C (validated)
  2649.           // 0x0e = Drive D
  2650.           // ...
  2651.  
  2652.           result := Ord(dump[9+_DriveNum(Drive)*2]);
  2653.         end
  2654.         else
  2655.         begin
  2656.           // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
  2657.  
  2658.           result := RES_DEFAULT; // Standardeinstellung bei Windows
  2659.         end;
  2660.       end;
  2661.  
  2662.       reg.CloseKey;
  2663.     end;
  2664.   finally
  2665.     reg.Free;
  2666.   end;
  2667. end;
  2668.  
  2669. function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;
  2670. var
  2671.   gpSetting: integer;
  2672. begin
  2673.   gpSetting := RecyclerGroupPolicyRecycleBinSize;
  2674.   if gpSetting <> -1 then
  2675.     result := gpSetting
  2676.   else if RecyclerHasGlobalSettings then
  2677.     result := RecyclerGlobalGetPercentUsage
  2678.   else
  2679.     result := RecyclerSpecificGetPercentUsage(Drive);
  2680. end;
  2681.  
  2682. function RecyclerGlobalIsNukeOnDelete: boolean;
  2683. var
  2684.   reg: TRegistry;
  2685.   dump: AnsiString;
  2686. const
  2687.   RES_DEFAULT = false;
  2688. begin
  2689.   result := false;
  2690.  
  2691.   reg := TRegistry.Create;
  2692.   try
  2693.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2694.  
  2695.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  2696.     begin
  2697.       if reg.ValueExists('NukeOnDelete') then
  2698.       begin
  2699.         // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  2700.  
  2701.         result := reg.ReadBool('NukeOnDelete');
  2702.       end
  2703.       else if reg.ValueExists('PurgeInfo') then
  2704.       begin
  2705.         // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
  2706.  
  2707.         // See comment at RecyclerSpecificIsNukeOnDelete()
  2708.  
  2709.         dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
  2710.         result := GetAnsiCharBit(dump[68], 3);
  2711.       end
  2712.       else
  2713.       begin
  2714.         // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
  2715.  
  2716.         result := RES_DEFAULT; // Standardeinstellung bei Windows
  2717.       end;
  2718.  
  2719.       reg.CloseKey;
  2720.     end;
  2721.   finally
  2722.     reg.Free;
  2723.   end;
  2724. end;
  2725.  
  2726. function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
  2727. var
  2728.   reg: TRegistry;
  2729.   dump: AnsiString;
  2730.   d: Byte;
  2731. const
  2732.   RES_DEFAULT = false;
  2733. begin
  2734.   result := false;
  2735.  
  2736.   reg := TRegistry.Create;
  2737.   try
  2738.     reg.RootKey := HKEY_LOCAL_MACHINE;
  2739.  
  2740.     if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
  2741.     begin
  2742.       if reg.OpenKeyReadOnly(Drive) then
  2743.       begin
  2744.         if reg.ValueExists('NukeOnDelete') then
  2745.         begin
  2746.           // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
  2747.  
  2748.           result := reg.ReadBool('NukeOnDelete');
  2749.         end;
  2750.         reg.CloseKey;
  2751.       end
  2752.       else
  2753.       begin
  2754.         if reg.ValueExists('PurgeInfo') then
  2755.         begin
  2756.           // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
  2757.  
  2758.           dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
  2759.  
  2760.           // NOT tested, only theoretical! My idea about the possible structure is:
  2761.           //
  2762.           // Byte      0x40       0x41       0x42       0x43
  2763.           // Bit       76543210   76543210   76543210   76543210
  2764.           //           --------   --------   --------   --------
  2765.           // Meaning   hgfedcba   ponmlkji   xwvutsrq   ????G?zy
  2766.           //
  2767.           // a..z = Drives
  2768.           // G    = global settings
  2769.           //
  2770.           // Already validated:
  2771.           // 0x64 = 04 (00000100)
  2772.           // 0x67 = 08 (00001000)
  2773.  
  2774.           d := _DriveNum(Drive);
  2775.           result := GetAnsiCharBit(dump[65+(d div 7)], d mod 7);
  2776.         end
  2777.         else
  2778.         begin
  2779.           // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
  2780.  
  2781.           result := RES_DEFAULT; // Standardeinstellung bei Windows
  2782.         end;
  2783.       end;
  2784.  
  2785.       reg.CloseKey;
  2786.     end;
  2787.   finally
  2788.     reg.Free;
  2789.   end;
  2790. end;
  2791.  
  2792. function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;
  2793. begin
  2794.   if RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
  2795.     result := true
  2796.   else if RecyclerHasGlobalSettings then
  2797.     result := RecyclerGlobalIsNukeOnDelete
  2798.   else
  2799.     result := RecyclerSpecificIsNukeOnDelete(Drive);
  2800. end;
  2801.  
  2802. function RecyclerHasGlobalSettings: boolean;
  2803. var
  2804.   reg: TRegistry;
  2805.   dump: string;