Subversion Repositories recyclebinunit

Rev

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