Subversion Repositories delphiutils

Rev

Rev 28 | Go to most recent revision | Blame | Last modification | View Log | RSS feed

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