Subversion Repositories recyclebinunit

Rev

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