Subversion Repositories recyclebinunit

Rev

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