Subversion Repositories recyclebinunit

Rev

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