Subversion Repositories recyclebinunit

Rev

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