Subversion Repositories recyclebinunit

Rev

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

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