Subversion Repositories recyclebinunit

Rev

Rev 27 | Rev 30 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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