Subversion Repositories recyclebinunit

Rev

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

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