Subversion Repositories recyclebinunit

Rev

Rev 16 | Rev 18 | 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
 
64
Demoapplikation: Dateien statt als Text als Explorer-Like?
65
Einzelne Elemente oder alle wiederherstellen oder löschen
66
Konfiguration für Laufwerke ändern etc
67
IconString -> TIcon Convertion functions
68
platzreservierung in mb-angabe berechnen
69
I don't know if there exists any API function which checks the state at any internal way.
70
 
71
*)
72
 
73
// TODO: Also include BC++ Versions
74
{$IFNDEF BCB}
75
{$DEFINE DEL1UP}
76
{$IFNDEF VER80}
77
{$DEFINE DEL2UP}
78
{$IFNDEF VER90}
79
{$DEFINE DEL3UP}
80
{$IFNDEF VER100}
81
{$DEFINE DEL4UP}
82
{$IFNDEF VER120}
83
{$DEFINE DEL5UP}
84
{$IFNDEF VER130}
85
{$DEFINE DEL6UP}
86
{$IFNDEF VER140}
87
{$DEFINE DEL7UP}
88
{$ENDIF}
89
{$ENDIF}
90
{$ENDIF}
91
{$ENDIF}
92
{$ENDIF}
93
{$ENDIF}
94
{$ENDIF}
95
 
96
{$IFDEF DEL7UP}
97
{$WARN UNSAFE_TYPE OFF}
98
{$WARN UNSAFE_CODE OFF}
99
{$WARN UNSAFE_CAST OFF}
100
{$ENDIF}
101
 
102
{$IFDEF DEL6UP}
103
unit RecyclerFunctions platform;
104
{$ELSE}
105
unit RecyclerFunctions;
106
{$ENDIF}
107
 
108
// Configuration
109
 
110
// If enabled, all functions with parameter "InfofileOrRecycleFolder" will
111
// also accept files which are not the indexfile (then, a INFO2 or INFO file
112
// will be searched in this directory).
113
{.$DEFINE allow_all_filenames}
114
 
115
interface
116
 
117
uses
118
  Windows, SysUtils, Classes, {$IFDEF DEL6UP}DateUtils,{$ENDIF}
119
  ShellApi{$IFNDEF DEL6UP}, FileCtrl{$ENDIF}, Registry,
120
  BitOps, Messages;
121
 
122
type
123
  EUnknownState = class(Exception);
124
  EEventCategoryNotDefined = class(Exception);
125
  EAPICallError = class(Exception);
126
 
127
  PSHQueryRBInfo = ^TSHQueryRBInfo;
128
  TSHQueryRBInfo = packed record
129
    cbSize      : dword;
130
    i64Size     : int64;
131
    i64NumItems : int64;
132
  end;
133
 
17 daniel-mar 134
  GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
135
 
12 daniel-mar 136
const
137
  RECYCLER_CLSID = '{645FF040-5081-101B-9F08-00AA002F954E}';
138
 
139
{$IFDEF DEL6UP}
140
function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
141
function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
142
function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
143
function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
144
{$ENDIF}
145
 
146
function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
147
function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
148
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
149
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
150
 
151
function RecyclerGetSource(drive: char; fileid: string): string; overload;
152
function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
153
function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
154
function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
155
 
156
procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
157
procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
158
procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
159
 
160
function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
161
function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
162
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
163
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
164
 
165
function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
166
function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
167
function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
168
function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
169
 
170
function RecyclerIsValid(drive: char): boolean; overload;
171
function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
172
function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
173
 
174
function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
175
function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
176
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
177
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
178
 
179
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
180
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
181
function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
182
function RecyclerGetPath(drive: char; UserSID: string): string; overload;
183
function RecyclerGetPath(drive: char): string; overload;
184
 
185
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
186
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
187
procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
188
procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
189
procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
190
 
191
function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
192
function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
193
function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
194
 
195
function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
196
function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
197
function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
198
 
199
procedure RecyclerGetAllRecyclerDrives(result: TStringList);
200
 
201
function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
202
function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
203
 
204
function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
205
function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
206
 
207
function RecyclerConfirmationDialogEnabled: boolean;
17 daniel-mar 208
function RecyclerShellStateConfirmationDialogEnabled: boolean;
12 daniel-mar 209
procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
210
 
211
function RecyclerGetCurrentIconString: string;
212
function RecyclerGetDefaultIconString: string;
213
function RecyclerGetEmptyIconString: string;
214
function RecyclerGetFullIconString: string;
215
 
216
function RecyclerGetName: string;
217
function RecyclerGetInfoTip: string;
218
function RecyclerGetIntroText: string;
219
 
220
function RecyclerEmptyEventGetName: string;
221
function RecyclerEmptyEventGetCurrentSound: string;
222
function RecyclerEmptyEventGetDefaultSound: string;
223
procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList);
224
function RecyclerEmptyEventGetSound(ACategory: string): string;
225
 
226
function RecyclerGlobalGetPercentUsage: integer;
227
function RecyclerSpecificGetPercentUsage(Drive: Char): integer;
228
function RecyclerGetPercentUsageAutoDeterminate(Drive: Char): integer;
229
 
230
function RecyclerGlobalIsNukeOnDelete: boolean;
231
function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
232
function RecyclerIsNukeOnDeleteAutoDeterminate(Drive: Char): boolean;
233
 
234
function RecyclerHasGlobalSettings: boolean;
235
 
236
function RecyclerIsEmpty: boolean; overload;
237
function RecyclerIsEmpty(Drive: Char): boolean; overload;
238
 
239
function RecyclerGetNumItems: int64; overload;
240
function RecyclerGetNumItems(Drive: Char): int64; overload;
241
 
242
function RecyclerGetSize: int64; overload;
243
function RecyclerGetSize(Drive: Char): int64; overload;
244
 
245
function RecyclerGetAPIInfo(Drive: Char): TSHQueryRBInfo; overload;
246
function RecyclerGetAPIInfo(Path: String): TSHQueryRBInfo; overload;
247
 
248
function RecyclerGetCLSID: string;
249
 
250
// Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer
251
// 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben
252
// werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da
253
// unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:
254
// - RecyclerIsEmpty
255
// - RecyclerGetNumItems
256
// - RecyclerGetSize
257
// - RecyclerGetAPIInfo
258
function RecyclerQueryFunctionAvailable: boolean;
259
 
17 daniel-mar 260
function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL;
261
function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL;
262
function RecyclerGroupPolicyRecycleBinSize: integer;
263
 
264
function GPBoolToString(value: GPOLICYBOOL): String;
265
 
12 daniel-mar 266
function RecyclerLibraryVersion: string;
267
 
268
implementation
269
 
270
type
271
  SHELLSTATE = record
272
    Flags1: DWORD;
273
(*
274
    BOOL fShowAllObjects : 1;
275
    BOOL fShowExtensions : 1;
276
    BOOL fNoConfirmRecycle : 1;
277
 
278
    BOOL fShowSysFiles : 1;
279
    BOOL fShowCompColor : 1;
280
    BOOL fDoubleClickInWebView : 1;
281
    BOOL fDesktopHTML : 1;
282
    BOOL fWin95Classic : 1;
283
    BOOL fDontPrettyPath : 1;
284
    BOOL fShowAttribCol : 1; // No longer used, dead bit
285
    BOOL fMapNetDrvBtn : 1;
286
    BOOL fShowInfoTip : 1;
287
    BOOL fHideIcons : 1;
288
    BOOL fWebView : 1;
289
    BOOL fFilter : 1;
290
    BOOL fShowSuperHidden : 1;
291
    BOOL fNoNetCrawling : 1;
292
*)
293
    dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts
294
    uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts
295
 
296
    // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM
297
    lParamSort: Integer;
298
    iSortDirection: Integer;
299
 
300
    version: UINT;
301
 
302
    // new for win2k. need notUsed var to calc the right size of ie4 struct
303
    // FIELD_OFFSET does not work on bit fields
304
    uNotUsed: UINT; // feel free to rename and use
305
    Flags2: DWORD;
306
(*
307
    BOOL fSepProcess: 1;
308
    // new for Whistler.
309
    BOOL fStartPanelOn: 1;       //Indicates if the Whistler StartPanel mode is ON or OFF.
310
    BOOL fShowStartPage: 1;      //Indicates if the Whistler StartPage on desktop is ON or OFF.
311
    UINT fSpareFlags : 13;
312
*)
313
  end;
314
  LPSHELLSTATE = ^SHELLSTATE;
315
 
316
const
317
  {$IFDEF MSWINDOWS}
318
    shell32  = 'shell32.dll';
319
    advapi32 = 'advapi32.dll';
320
  {$ENDIF}
321
  {$IFDEF LINUX}
322
    shell32  = 'libshell32.borland.so';
323
    advapi32 = 'libwine.borland.so';
324
  {$ENDIF}
325
 
326
  // Masks for the shellstate
327
   SSF_SHOWALLOBJECTS  = $00000001;
328
  SSF_SHOWEXTENSIONS  = $00000002;
329
  SSF_HIDDENFILEEXTS  = $00000004;
330
  SSF_SERVERADMINUI   = $00000004;
331
  SSF_SHOWCOMPCOLOR   = $00000008;
332
  SSF_SORTCOLUMNS     = $00000010;
333
  SSF_SHOWSYSFILES    = $00000020;
334
  SSF_DOUBLECLICKINWEBVIEW = $00000080;
335
  SSF_SHOWATTRIBCOL   = $00000100;
336
  SSF_DESKTOPHTML     = $00000200;
337
  SSF_WIN95CLASSIC    = $00000400;
338
  SSF_DONTPRETTYPATH  = $00000800;
339
  SSF_SHOWINFOTIP     = $00002000;
340
  SSF_MAPNETDRVBUTTON = $00001000;
341
  SSF_NOCONFIRMRECYCLE = $00008000;
342
  SSF_HIDEICONS       = $00004000;
343
  SSF_FILTER          = $00010000;
344
  SSF_WEBVIEW         = $00020000;
345
  SSF_SHOWSUPERHIDDEN = $00040000;
346
  SSF_SEPPROCESS      = $00080000;
347
  SSF_NONETCRAWLING   = $00100000;
348
  SSF_STARTPANELON    = $00200000;
349
  SSF_SHOWSTARTPAGE   = $00400000;
350
 
351
// **********************************************************
352
// COMPATIBILITY FUNCTIONS
353
// **********************************************************
354
 
355
{$IFNDEF DEL5UP}
356
function IncludeTrailingBackslash(str: string): string;
357
begin
358
  if Copy(str, length(str), 1) = '\' then    // TODO? Gibt es PathDelim in Delphi 4?
359
    Result := str
360
  else
361
    Result := str + '\';
362
end;
363
{$ENDIF}
364
 
365
// **********************************************************
366
// INTERNALLY USED FUNCTIONS
367
// **********************************************************
368
 
369
type
370
  TNibble = $0..$F;
371
  TBitPos = 0..7;
372
 
373
resourcestring
374
  LNG_UNEXPECTED_STATE = 'Cannot determinate state of "%s" because of an unknown value in the configuration of your operation system. Please contact the developer of the Recycler Bin Unit and help improving the determination methods!';
375
  LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';
376
  LNG_NOT_CALLABLE = '%s not callable';
377
  LNG_ERROR_CODE = '%s returns error code %s';
378
 
379
function _GetBit(B: Byte; BitPos: TBitPos): boolean; overload;
380
var
381
  p: byte;
382
begin
383
  p := 1 shl BitPos; // 2 ^ BitPos
384
  result := B and p = p;
385
end;
386
 
387
function _GetBit(B: Char; BitPos: TBitPos): boolean; overload;
388
begin
389
  result := _GetBit(Ord(B), BitPos);
390
end;
391
 
392
function _DriveNum(Drive: Char): Byte;
393
// a->0, ..., z->25
394
var
395
  tmp: string;
396
begin
397
  tmp := LowerCase(Drive);
398
  result := Ord(tmp[1])-Ord('a');
399
end;
400
 
401
function _registryReadDump(AReg: TRegistry; AName: string): string;
402
const
403
  // Win2000 RegEdit has set the max input length of a REG_BINARY to $3FFF.
404
  // Probably its the longest possible binary string and not just a GUI limit.
405
  BufMax = $3FFF;
406
var
407
  buf: array[0..BufMax] of byte;
408
  i: integer;
409
  realsize: integer;
410
begin
411
  realsize := AReg.ReadBinaryData(AName, buf, SizeOf(buf));
412
 
413
  for i := 0 to realsize-1 do
414
  begin
415
    result := result + chr(buf[i]);
416
  end;
417
end;
418
 
419
function _LowerNibble(B: Byte): TNibble;
420
begin
421
  result := B and 15 {00001111};
422
end;
423
 
424
(* function _UpperNibble(B: Byte): TNibble;
425
begin
426
  result := B and 240 {11110000};
427
end;
428
 
429
function _MakeByte(UpperNibble, LowerNibble: TNibble): Byte;
430
begin
431
  result := LowerNibble + UpperNibble * $10;
432
end; *)
433
 
434
function _GetStringFromDLL(filename: string; num: integer): string;
435
const
436
  // http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp
437
  MAX_BUF = 4097; // OK?
438
var
439
  hLib: THandle;
440
  buf: array[0..MAX_BUF] of char;
441
begin
442
  hLib := LoadLibrary(PChar(filename));
443
  try
444
    LoadString(hLib, num, buf, sizeof(buf));
445
    result := buf;
446
  finally
447
    FreeLibrary(hLib);
448
  end;
449
end;
450
 
451
// http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html
452
function _ExpandEnvStr(const szInput: string): string;
453
const
454
  MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
455
begin
456
  SetLength(Result,MAXSIZE);
457
  SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
458
    @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
459
end;
460
 
461
// Beispiele
462
// Papierkorb                                                 -- Windows 95
463
// @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000
464
 
465
function _DecodeReferenceString(s: string): string;
466
var
467
  dll, id, lang, cache: string;
468
  sl, sl2: tstringlist;
469
begin
470
  if Copy(s, 1, 1) = '@' then
471
  begin
472
    // Referenz auf eine DLL
473
    // @<dll>,-<id>[@<lang>][,<cache>]
474
 
475
    sl := TStringList.Create;
476
    try
477
      // '@' am Anfang entfernen
478
      s := Copy(s, 2, length(s)-1);
479
 
480
      // Nach ',' auftrennen
481
      // sl[0] --> dll
482
      // sl[1] --> -id@lang
483
      // sl[2] --> cache
484
      sl.CommaText := s;
485
 
486
      if sl.Count > 2 then
487
      begin
488
        // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden
489
        // Ist bei Windows 2000 der Fall
490
        cache := sl[2];
491
        result := cache;
492
        exit;
493
      end;
494
 
495
      if sl.Count > 1 then
496
      begin
497
        dll := sl[0];
498
 
499
        sl2 := TStringList.Create;
500
        try
501
          // Nach '@' auftrennen
502
          // sl2[0] --> id
503
          // sl2[1] --> lang
504
          sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);
505
 
506
          id := sl2[0];
507
 
508
          if sl2.Count > 1 then
509
          begin
510
            // ToDo: In Zukunft beachten, sofern möglich
511
            lang := sl2[1];
512
          end;
513
 
514
          // Umgebungsvariablen erkennen und Minuszeichen entfernen
515
          result := _GetStringFromDLL(_ExpandEnvStr(dll), -StrToInt(id));
516
        finally
517
          sl2.Free;
518
        end;
519
      end
520
      else
521
      begin
522
        // Zu wenige Informationen!
523
 
524
        result := '';
525
      end;
526
    finally
527
      sl.Free;
528
    end;
529
  end
530
  else
531
  begin
532
    // Kein Hinweis auf eine Referenz
533
    result := s;
534
  end;
535
end;
536
 
537
function _readInt8(const Stream: TStream): byte;
538
var
539
  I: integer;
540
begin
541
  i := 0;
542
  Stream.ReadBuffer(i, 1);
543
  Result := i;
544
end;
545
 
546
function _readInt32(const Stream: TStream): Longword;
547
var
548
  I: integer;
549
begin
550
  i := 0;
551
  Stream.ReadBuffer(i, 4);
552
  Result := i;
553
end;
554
 
555
function _readInt64(const Stream: TStream): int64;
556
var
557
  I: int64;
558
begin
559
  i := 0;
560
  Stream.ReadBuffer(i, 8);
561
  Result := i;
562
end;
563
 
564
function _readChar(const Stream: TStream): char;
565
var
566
  C: Char;
567
begin
568
  C := #0;
569
  Stream.ReadBuffer(C, 1);
570
  Result := C;
571
end;
572
 
573
function _readNullTerminatedString(const Stream: TStream): String;
574
var
575
  S: String;
576
  C: Char;
577
begin
578
  S := '';
579
  repeat
580
    Stream.ReadBuffer(C, 1);
581
    if (C <> #0) then
582
      S := S + C;
583
  until C = #0;
584
  Result := S;
585
end;
586
 
587
// http://www.delphipraxis.net/post761928.html#761928
588
function _readNullTerminatedWideString(const Stream: TStream): WideString;
589
var
590
  S: WideString;
591
  WC: WideChar;
592
begin
593
  S := '';
594
  repeat
595
    Stream.ReadBuffer(WC, 2);
596
    if (WC <> #0) then
597
      S := S + WC;
598
  until WC = #0;
599
  Result := S;
600
end;
601
 
602
// http://www.delphipraxis.net/post340194.html#340194
603
function _nowUTC: TDateTime;
604
var
605
  SystemTime: TSystemTime;
606
begin
607
  GetSystemTime(SystemTime);
608
  with SystemTime do
609
  begin
610
    Result := EncodeDate(wYear, wMonth, wDay) +
611
              EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
612
  end;
613
end;
614
 
615
{$IFDEF DEL6UP}
616
function _getGMTDifference(): extended;
617
begin
618
  result := - (datetimetounix(_nowUTC())-datetimetounix(Now())) / 3600;
619
end;
620
 
621
function _fileTimeToDateTime(FileTime: int64): TDateTime;
622
begin
623
  // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf
624
  // UnixTime = 0.0000001 * NTTime + 11644473600
625
  // This is wrong! The correct formula is:
626
  // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600
627
  // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)
628
  result := unixtodatetime(FileTime div 10000000 - 11644473600 + round(_getGMTDifference() * 3600));
629
end;
630
{$ENDIF}
631
 
632
// http://www.delphipraxis.net/post471470.html
633
function _getAccountSid(const Server, User: WideString; var Sid: PSID): DWORD;
634
var
635
  dwDomainSize, dwSidSize: DWord;
636
  R: LongBool;
637
  wDomain: WideString;
638
  Use: DWord;
639
begin
640
  Result := 0;
641
  SetLastError(0);
642
  dwSidSize := 0;
643
  dwDomainSize := 0;
644
  R := LookupAccountNameW(PWideChar(Server), PWideChar(User), nil, dwSidSize,
645
       nil, dwDomainSize, Use);
646
  if (not R) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
647
  begin
648
    SetLength(wDomain, dwDomainSize);
649
    Sid := GetMemory(dwSidSize);
650
    R := LookupAccountNameW(PWideChar(Server), PWideChar(User), Sid,
651
         dwSidSize, PWideChar(wDomain), dwDomainSize, Use);
652
    if not R then
653
    begin
654
      FreeMemory(Sid);
655
      Sid := nil;
656
    end;
657
  end
658
  else
659
    Result := GetLastError;
660
end;
661
 
662
// Template:
663
// http://www.latiumsoftware.com/en/pascal/0014.php
664
function _getLoginNameW: widestring;
665
var
666
  Buffer: array[0..255] of widechar;
667
  Size: dword;
668
begin
669
  Size := 256;
670
  if GetUserNameW(Buffer, Size) then
671
    Result := Buffer
672
  else
673
    Result := 'User';
674
end;
675
 
676
function _Dyn_ConvertSidToStringSidA(SID: PSID; var strSID: LPSTR): boolean;
677
type
678
  DllReg = function(SID: PSID; var StringSid: LPSTR): Boolean; stdcall;
679
var
680
  hDll: THandle;
681
  dr: DllReg;
682
begin
683
  result := false;
684
  hDll := LoadLibrary(advapi32);
685
  if hDll <> 0 then
686
  begin
687
    @dr := GetProcAddress(hDll, 'ConvertSidToStringSidA');
688
    if assigned(dr) then
689
    begin
690
      result := dr(SID, strSID);
691
    end;
692
  end;
693
end;
694
 
695
// http://www.delphipraxis.net/post471470.html
696
// Changed
697
function _getMySID(): string;
698
var
699
  SID: PSID;
700
  strSID: PAnsiChar;
701
  s: String;
702
  err: DWORD;
703
begin
704
  SID := nil;
705
 
706
  err := _getAccountSid('', _getLoginNameW(), SID);
707
 
708
  if err = 0 then
709
  begin
710
    if _Dyn_ConvertSidToStringSidA(SID, strSID) then
711
      s := string(strSID)
712
    else
713
      s := SysErrorMessage(err);
714
  end
715
  else
716
    s := SysErrorMessage(err);
717
 
718
  result := s;
719
end;
720
 
721
// Originalcode aus http://www.delphipraxis.net/post2933.html
722
function _DriveExists(DriveByte: Byte): Boolean; overload;
723
begin
724
  Result := GetLogicalDrives and (1 shl DriveByte) <> 0;
725
end;
726
 
727
function _driveExists(Drive: Char): Boolean; overload;
728
var
729
  DriveByte: Byte;
730
  tmp: string;
731
begin
732
  // Make drive letter upper case (for older Delphi versions)
733
  tmp := UpperCase(Drive);
734
  Drive := tmp[1];
735
 
736
  DriveByte := Ord(Drive) - Ord('A');
737
  Result := _DriveExists(DriveByte);
738
end;
739
 
740
function _isFAT(drive: char): boolean;
741
var
742
  Dummy2: DWORD;
743
  Dummy3: DWORD;
744
  FileSystem: array[0..MAX_PATH] of char;
745
  VolumeName: array[0..MAX_PATH] of char;
746
  s: string;
747
begin
748
  result := false;
749
  if _driveExists(drive) then
750
  begin
751
    s := drive + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll
752
    GetVolumeInformation(PChar(s), VolumeName,
753
      SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem));
754
    result := uppercase(copy(FileSystem, 0, 3)) = 'FAT';
755
  end;
756
end;
757
 
758
// http://www.delphipages.com/tips/thread.cfm?ID=294
759
// Changed
760
(* function IsWin95: boolean;
761
var
762
  OS: TOSVersionInfo;
763
begin
764
  ZeroMemory(@OS, SizeOf(OS));
765
  OS.dwOSVersionInfoSize := SizeOf(OS);
766
  GetVersionEx(OS);
767
  // http://www.gaijin.at/lstwinver.php
768
  Result := (OS.dwMajorVersion = 4) and (OS.dwMinorVersion <= 3) and
769
            (OS.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS);
770
end; *)
771
 
772
// http://www.delphipages.com/tips/thread.cfm?ID=294
773
// Changed
774
function _isVista: boolean;
775
var
776
  OS: TOSVersionInfo;
777
begin
778
  ZeroMemory(@OS, SizeOf(OS));
779
  OS.dwOSVersionInfoSize := SizeOf(OS);
780
  GetVersionEx(OS);
781
  // http://www.gaijin.at/lstwinver.php
782
  Result := (OS.dwMajorVersion = 6) and (OS.dwMinorVersion = 0) and
783
            (OS.dwPlatformId=VER_PLATFORM_WIN32_NT);
784
end;
785
 
786
// **********************************************************
787
// VISTA FUNCTIONS, INTERNAL USED
788
// **********************************************************
789
 
790
function _isFileVistaRealfile(filename: string): boolean;
791
begin
792
  result := uppercase(copy(extractfilename(filename), 0, 2)) = '$R';
793
end;
794
 
795
function _isFileVistaIndexfile(filename: string): boolean;
796
begin
797
  result := uppercase(copy(extractfilename(filename), 0, 2)) = '$I';
798
end;
799
 
800
function _isFileVistaNamed(filename: string): boolean;
801
begin
802
  result := _isFileVistaIndexfile(filename) or
803
            _isFileVistaRealfile(filename);
804
end;
805
 
806
function _VistaChangeRealfileToIndexfile(realfile: string): string;
807
begin
808
  if _isFileVistaRealfile(realfile) then
809
  begin
810
    result := extractfilepath(realfile)+'$I'+
811
      copy(extractfilename(realfile), 3, length(extractfilename(realfile))-2);
812
  end
813
  else
814
    result := realfile; // ignore, even if it is not a vista recycle-file
815
end;
816
 
817
function _VistaChangeIndexfileToRealfile(indexfile: string): string;
818
begin
819
  if _isFileVistaIndexfile(indexfile) then
820
  begin
821
    result := extractfilepath(indexfile)+'$R'+
822
      copy(extractfilename(indexfile), 3, length(extractfilename(indexfile))-2);
823
  end
824
  else
825
    result := indexfile; // ignore, even if it is not a vista recycle-file
826
end;
827
 
828
procedure _VistaListIndexes(recyclerpath: string; result: TStringList);
829
var
830
  sr: TSearchRec;
831
  r: Integer;
832
  tmp: string;
833
begin
834
  tmp := recyclerpath;
835
  tmp := IncludeTrailingBackslash(tmp);
836
 
837
  if not directoryexists(tmp) then exit;
838
 
839
  r := FindFirst(tmp+PathDelim + '$I*', faAnyFile, sr);
840
  while r = 0 do
841
  begin
842
    if (sr.Name <> '.') and (sr.Name <> '..') then
843
    begin
844
      if sr.Size = $220 then
845
      begin
846
        result.Add(copy(sr.name, 3, length(sr.name)-2));
847
      end;
848
    end;
849
    r := FindNext(sr);
850
  end;
851
 
852
  FindClose(sr);
853
end;
854
 
855
function _VistaCurrentFilename(infofilename: string): string;
856
begin
857
  result := extractfilename(infofilename);
858
 
859
  if _isFileVistaRealfile(result) then
860
  begin
861
    exit;
862
  end;
863
 
864
  if _isFileVistaIndexfile(result) then
865
  begin
866
    result := _VistaChangeIndexfileToRealfile(result);
867
    exit;
868
  end;
869
 
870
  result := copy(result, 3, length(result)-2);
871
  result := '$R'+result;
872
end;
873
 
874
function _VistaGetSourceDrive(infofile: string): char;
875
var
876
  fs: TFileStream;
877
  tmp: string;
878
const
879
  drive_vista_position = $18;
880
begin
881
  result := #0;
882
 
883
  tmp := infofile;
884
  tmp := _VistaChangeRealfileToIndexfile(tmp);
885
  if not fileexists(tmp) then exit;
886
 
887
  fs := TFileStream.Create(tmp, fmOpenRead);
888
  try
889
    fs.seek(drive_vista_position, soFromBeginning);
890
    result := _readChar(fs);
891
  finally
892
    fs.free;
893
  end;
894
end;
895
 
896
{$IFDEF DEL6UP}
897
function _VistaGetDateTime(infofile: string): TDateTime;
898
var
899
  fs: TFileStream;
900
  tmp: string;
901
const
902
  timestamp_vista_position = $10;
903
begin
904
  result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
905
 
906
  tmp := infofile;
907
  tmp := _VistaChangeRealfileToIndexfile(tmp);
908
  if not fileexists(tmp) then exit;
909
 
910
  fs := TFileStream.Create(tmp, fmOpenRead);
911
  try
912
    fs.seek(timestamp_vista_position, soFromBeginning);
913
    result := _fileTimeToDateTime(_readInt64(fs));
914
  finally
915
    fs.free;
916
  end;
917
end;
918
{$ENDIF}
919
 
920
function _VistaGetSourceUnicode(infofile: string): string;
921
var
922
  fs: TFileStream;
923
  tmp: string;
924
const
925
  unicode_vista_position = $18;
926
begin
927
  result := '';
928
 
929
  tmp := infofile;
930
  tmp := _VistaChangeRealfileToIndexfile(tmp);
931
  if not fileexists(tmp) then exit;
932
 
933
  fs := TFileStream.Create(tmp, fmOpenRead);
934
  try
935
    fs.seek(unicode_vista_position, soFromBeginning);
936
    result := _readNullTerminatedWideString(fs);
937
  finally
938
    fs.free;
939
  end;
940
end;
941
 
942
function _VistaOriginalSize(infofile: string): integer;
943
var
944
  fs: TFileStream;
945
  tmp: string;
946
const
947
  size_vista_position = $8;
948
begin
949
  result := -1;
950
 
951
  tmp := infofile;
952
  tmp := _VistaChangeRealfileToIndexfile(tmp);
953
  if not fileexists(tmp) then exit;
954
 
955
  fs := TFileStream.Create(tmp, fmOpenRead);
956
  try
957
    fs.seek(size_vista_position, soFromBeginning);
958
    result := _readInt32(fs);
959
  finally
960
    fs.free;
961
  end;
962
end;
963
 
964
function _checkInfo1or2File(filename: string): boolean;
965
var
966
  fs: TStream;
967
  record_length: integer;
968
const
969
  length_position = $C;
970
  empty_size = 20;
971
begin
972
  fs := TFileStream.Create(filename, fmOpenRead);
973
  try
974
    fs.seek(length_position, soFromBeginning);
975
    record_length := _readInt32(fs);
976
 
977
    // Check the file length
978
    if record_length = 0 then
979
      result := false
980
    else
981
      result := (fs.size - empty_size) mod record_length = 0;
982
  finally
983
    fs.free;
984
  end;
985
end;
986
 
987
function _VistaIsValid(infofile: string): boolean;
988
var
989
  fs: TFileStream;
990
  tmp: string;
991
const
992
  vista_valid_size = $220;
993
begin
994
  result := false;
995
 
996
  tmp := infofile;
997
  tmp := _VistaChangeRealfileToIndexfile(tmp);
998
  if not fileexists(tmp) then exit;
999
 
1000
  fs := TFileStream.Create(tmp, fmOpenRead);
1001
  try
1002
    // Check the file length
1003
    result := fs.size = vista_valid_size;
1004
  finally
1005
    fs.free;
1006
  end;
1007
end;
1008
 
1009
// **********************************************************
1010
// PUBLIC FUNCTIONS
1011
// **********************************************************
1012
 
1013
{$IFDEF DEL6UP}
1014
 
1015
function RecyclerGetDateTime(InfofileOrRecycleFolder: string): tdatetime; overload;
1016
begin
1017
  result := RecyclerGetDateTime(InfofileOrRecycleFolder, '');
1018
end;
1019
 
1020
function RecyclerGetDateTime(drive: char; fileid: string): tdatetime; overload;
1021
begin
1022
  result := RecyclerGetDateTime(drive, '', fileid);
1023
end;
1024
 
1025
function RecyclerGetDateTime(drive: char; UserSID: string; fileid: string): tdatetime; overload;
1026
var
1027
  infofile: string;
1028
begin
1029
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1030
  result := RecyclerGetDateTime(infofile, fileid);
1031
end;
1032
 
1033
function RecyclerGetDateTime(InfofileOrRecycleFolder: string; id: string): tdatetime; overload;
1034
var
1035
  fs: TFileStream;
1036
  i, record_length: integer;
1037
  tmp: string;
1038
const
1039
  length_position = $C;
1040
  unique_index_position = $118;
1041
  timestamp_position = $120;
1042
begin
1043
  // FILETIME does start at 01.01.1601 00:00:00 (GMT)
1044
  result := EncodeDateTime(1601, 1, 1, 0, 0, 0, 0);
1045
 
1046
  tmp := InfofileOrRecycleFolder;
1047
 
1048
  if _isFileVistaNamed(tmp) then
1049
  begin
1050
    result := _VistaGetDateTime(tmp);
1051
    exit;
1052
  end;
1053
 
1054
  {$IFDEF allow_all_filenames}
1055
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1056
  begin
1057
    if fileexists(extractfilepath(tmp)+'INFO2') then
1058
      tmp := extractfilepath(tmp)+'INFO2'
1059
    else if fileexists(extractfilepath(tmp)+'INFO') then
1060
      tmp := extractfilepath(tmp)+'INFO';
1061
  end;
1062
  {$ENDIF}
1063
 
1064
  if directoryexists(tmp) then
1065
  begin
1066
    tmp := IncludeTrailingBackslash(tmp);
1067
 
1068
    if fileexists(tmp+'$I'+id) then
1069
    begin
1070
      result := _VistaGetDateTime(tmp+'$I'+id);
1071
      exit;
1072
    end
1073
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1074
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1075
  end;
1076
 
1077
  if not fileexists(tmp) then exit;
1078
  if not RecyclerIsValid(tmp) then exit;
1079
 
1080
  fs := TFileStream.Create(tmp, fmOpenRead);
1081
  try
1082
    fs.seek(length_position, soFromBeginning);
1083
    record_length := _readInt32(fs);
1084
 
1085
    i := -1;
1086
    repeat
1087
      inc(i);
1088
      if unique_index_position+i*record_length > fs.size then break;
1089
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
1090
      if inttostr(_readInt32(fs)) = id then
1091
      begin
1092
        fs.seek(timestamp_position+i*record_length, soFromBeginning);
1093
        result := _fileTimeToDateTime(_readInt64(fs));
1094
        break;
1095
      end;
1096
      until false;
1097
  finally
1098
    fs.free;
1099
  end;
1100
end;
1101
 
1102
{$ENDIF}
1103
 
1104
////////////////////////////////////////////////////////////////////////////////
1105
 
1106
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string): WideString; overload;
1107
begin
1108
  result := RecyclerGetSourceUnicode(InfofileOrRecycleFolder, '');
1109
end;
1110
 
1111
function RecyclerGetSourceUnicode(drive: char; fileid: string): WideString; overload;
1112
begin
1113
  result := RecyclerGetSourceUnicode(drive, '', fileid);
1114
end;
1115
 
1116
function RecyclerGetSourceUnicode(drive: char; UserSID: string; fileid: string): WideString; overload;
1117
var
1118
  infofile: string;
1119
begin
1120
  if Win32Platform = VER_PLATFORM_WIN32_NT then
1121
  begin
1122
    infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1123
    result := RecyclerGetSourceUnicode(infofile, fileid);
1124
  end
1125
  else
1126
  begin
1127
    // Windows 9x does not support unicode
1128
    result := RecyclerGetSource(drive, UserSID, fileid);
1129
  end;
1130
end;
1131
 
1132
function RecyclerGetSourceUnicode(InfofileOrRecycleFolder: string; id: string): WideString; overload;
1133
var
1134
  fs: TFileStream;
1135
  i, record_length: integer;
1136
  tmp: string;
1137
const
1138
  length_position = $C;
1139
  unique_index_position = $118;
1140
  unicode_source_position = $12C;
1141
begin
1142
  result := '';
1143
 
1144
  tmp := InfofileOrRecycleFolder;
1145
 
1146
  if _isFileVistaNamed(tmp) then
1147
  begin
1148
    // Vista only gives unicode names
1149
    result := _VistaGetSourceUnicode(tmp);
1150
    exit;
1151
  end;
1152
 
1153
  {$IFDEF allow_all_filenames}
1154
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1155
  begin
1156
    if fileexists(extractfilepath(tmp)+'INFO2') then
1157
      tmp := extractfilepath(tmp)+'INFO2'
1158
    else if fileexists(extractfilepath(tmp)+'INFO') then
1159
      tmp := extractfilepath(tmp)+'INFO';
1160
  end;
1161
  {$ENDIF}
1162
 
1163
  if directoryexists(tmp) then
1164
  begin
1165
    tmp := IncludeTrailingBackslash(tmp);
1166
 
1167
    if fileexists(tmp+'$I'+id) then
1168
    begin
1169
      // Vista only gives unicode names
1170
      result := _VistaGetSourceUnicode(tmp+'$I'+id);
1171
      exit;
1172
    end
1173
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1174
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1175
  end;
1176
 
1177
  if not fileexists(tmp) then exit;
1178
  if not RecyclerIsValid(tmp) then exit;
1179
 
1180
  fs := TFileStream.Create(tmp, fmOpenRead);
1181
  try
1182
    fs.seek(length_position, soFromBeginning);
1183
    record_length := _readInt32(fs);
1184
 
1185
    if record_length <> $118 then
1186
    begin
1187
      // Windows NT
1188
      i := -1;
1189
      repeat
1190
        inc(i);
1191
        if unique_index_position+i*record_length > fs.size then break;
1192
        fs.seek(unique_index_position+i*record_length, soFromBeginning);
1193
        if inttostr(_readInt32(fs)) = id then
1194
        begin
1195
          fs.seek(unicode_source_position+i*record_length, soFromBeginning);
1196
          result := _readNullTerminatedWideString(fs);
1197
          break;
1198
        end;
1199
      until false;
1200
    end;
1201
  finally
1202
    fs.free;
1203
  end;
1204
 
1205
  if record_length = $118 then
1206
  begin
1207
    // Windows 9x has no unicode support
1208
    result := RecyclerGetSource(tmp, id);
1209
  end;
1210
end;
1211
 
1212
////////////////////////////////////////////////////////////////////////////////
1213
 
1214
function RecyclerGetSource(InfofileOrRecycleFolder: string): string; overload;
1215
begin
1216
  result := RecyclerGetSource(InfofileOrRecycleFolder, '');
1217
end;
1218
 
1219
function RecyclerGetSource(drive: char; fileid: string): string; overload;
1220
begin
1221
  result := RecyclerGetSource(drive, '', fileid);
1222
end;
1223
 
1224
function RecyclerGetSource(drive: char; UserSID: string; fileid: string): string; overload;
1225
var
1226
  infofile: string;
1227
begin
1228
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1229
  result := RecyclerGetSource(infofile, fileid);
1230
end;
1231
 
1232
function RecyclerGetSource(InfofileOrRecycleFolder: string; id: string): string; overload;
1233
var
1234
  fs: TFileStream;
1235
  i, record_length: integer;
1236
  tmp: string;
1237
  alternativ: string;
1238
const
1239
  length_position = $C;
1240
  unique_index_position = $118;
1241
  source_position = $14;
1242
begin
1243
  result := '';
1244
 
1245
  tmp := InfofileOrRecycleFolder;
1246
 
1247
  if _isFileVistaNamed(tmp) then
1248
  begin
1249
    // Vista only gives unicode names
1250
    result := _VistaGetSourceUnicode(tmp);
1251
    exit;
1252
  end;
1253
 
1254
  {$IFDEF allow_all_filenames}
1255
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1256
  begin
1257
    if fileexists(extractfilepath(tmp)+'INFO2') then
1258
      tmp := extractfilepath(tmp)+'INFO2'
1259
    else if fileexists(extractfilepath(tmp)+'INFO') then
1260
      tmp := extractfilepath(tmp)+'INFO';
1261
  end;
1262
  {$ENDIF}
1263
 
1264
  if directoryexists(tmp) then
1265
  begin
1266
    tmp := IncludeTrailingBackslash(tmp);
1267
 
1268
    if fileexists(tmp+'$I'+id) then
1269
    begin
1270
      // Vista only gives unicode names
1271
      result := _VistaGetSourceUnicode(tmp+'$I'+id);
1272
      exit;
1273
    end
1274
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1275
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1276
  end;
1277
 
1278
  if not fileexists(tmp) then exit;
1279
  if not RecyclerIsValid(tmp) then exit;
1280
 
1281
  fs := TFileStream.Create(tmp, fmOpenRead);
1282
  try
1283
    fs.seek(length_position, soFromBeginning);
1284
    record_length := _readInt32(fs);
1285
 
1286
    i := -1;
1287
    repeat
1288
      inc(i);
1289
      if unique_index_position+i*record_length > fs.size then break;
1290
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
1291
      if inttostr(_readInt32(fs)) = id then
1292
      begin
1293
        fs.seek(source_position+i*record_length, soFromBeginning);
1294
        alternativ := _readChar(fs);
1295
 
1296
        if alternativ = #0 then
1297
        begin
1298
          fs.seek(source_position+i*record_length+1, soFromBeginning);
1299
          result := _readNullTerminatedString(fs);
1300
        end
1301
        else
1302
        begin
1303
          fs.seek(source_position+i*record_length, soFromBeginning);
1304
          result := _readNullTerminatedString(fs);
1305
        end;
1306
 
1307
        break;
1308
      end;
1309
    until false;
1310
  finally
1311
    fs.free;
1312
  end;
1313
 
1314
  // In some cases the ansi-source-name is [Null]:\...\
1315
  if alternativ = #0 then
1316
  begin
1317
    result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, id) + result;
1318
  end;
1319
end;
1320
 
1321
////////////////////////////////////////////////////////////////////////////////
1322
 
1323
procedure RecyclerListIndexes(drive: char; result: TStringList); overload;
1324
begin
1325
  RecyclerListIndexes(drive, '', result);
1326
end;
1327
 
1328
procedure RecyclerListIndexes(drive: char; UserSID: string; result: TStringList); overload;
1329
var
1330
  infofile: string;
1331
begin
1332
  infofile := RecyclerGetPath(drive, UserSID, false);
1333
  RecyclerListIndexes(infofile, result);
1334
end;
1335
 
1336
procedure RecyclerListIndexes(InfofileOrRecycleFolder: string; result: TStringList); overload;
1337
var
1338
  fs: TFileStream;
1339
  i, record_length: integer;
1340
  tmp: string;
1341
const
1342
  length_position = $C;
1343
  unique_index_position = $118;
1344
begin
1345
  tmp := InfofileOrRecycleFolder;
1346
 
1347
  if _isFileVistaNamed(tmp) then
1348
  begin
1349
    _VistaListIndexes(extractfilepath(tmp), result);
1350
    exit;
1351
  end;
1352
 
1353
  {$IFDEF allow_all_filenames}
1354
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1355
  begin
1356
    if fileexists(extractfilepath(tmp)+'INFO2') then
1357
      tmp := extractfilepath(tmp)+'INFO2'
1358
    else if fileexists(extractfilepath(tmp)+'INFO') then
1359
      tmp := extractfilepath(tmp)+'INFO';
1360
  end;
1361
  {$ENDIF}
1362
 
1363
  if directoryexists(tmp) then
1364
  begin
1365
    tmp := IncludeTrailingBackslash(tmp);
1366
 
1367
    if fileexists(tmp+'INFO2') then     tmp := tmp+'INFO2'
1368
    else if fileexists(tmp+'INFO') then tmp := tmp+'INFO'
1369
    else
1370
    begin
1371
      // Last try: is it a vista-directory?
1372
      _VistaListIndexes(tmp, result);
1373
      exit;
1374
    end;
1375
  end;
1376
 
1377
  if not fileexists(tmp) then exit;
1378
  if not RecyclerIsValid(tmp) then exit;
1379
 
1380
  fs := TFileStream.Create(tmp, fmOpenRead);
1381
  try
1382
    fs.seek(length_position, soFromBeginning);
1383
    record_length := _readInt32(fs);
1384
 
1385
    i := -1;
1386
    repeat
1387
      inc(i);
1388
      if unique_index_position+i*record_length > fs.size then break;
1389
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
1390
 
1391
      result.Add(inttostr(_readInt32(fs)));
1392
    until false;
1393
  finally
1394
    fs.free;
1395
  end;
1396
end;
1397
 
1398
////////////////////////////////////////////////////////////////////////////////
1399
 
1400
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string): char; overload;
1401
begin
1402
  result := RecyclerGetSourceDrive(InfofileOrRecycleFolder, '');
1403
end;
1404
 
1405
function RecyclerGetSourceDrive(drive: char; fileid: string): char; overload;
1406
begin
1407
  result := RecyclerGetSourceDrive(drive, '', fileid);
1408
end;
1409
 
1410
function RecyclerGetSourceDrive(drive: char; UserSID: string; fileid: string): char; overload;
1411
var
1412
  infofile: string;
1413
begin
1414
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1415
  result := RecyclerGetSourceDrive(infofile, fileid);
1416
end;
1417
 
1418
function RecyclerGetSourceDrive(InfofileOrRecycleFolder: string; id: string): char; overload;
1419
var
1420
  fs: TFileStream;
1421
  i, record_length: integer;
1422
  tmp: string;
1423
const
1424
  length_position = $C;
1425
  unique_index_position = $118;
1426
  source_drive_position = $11C;
1427
begin
1428
  result := #0;
1429
 
1430
  tmp := InfofileOrRecycleFolder;
1431
 
1432
  if _isFileVistaNamed(tmp) then
1433
  begin
1434
    result := _VistaGetSourceDrive(tmp);
1435
    exit;
1436
  end;
1437
 
1438
  {$IFDEF allow_all_filenames}
1439
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1440
  begin
1441
    if fileexists(extractfilepath(tmp)+'INFO2') then
1442
      tmp := extractfilepath(tmp)+'INFO2'
1443
    else if fileexists(extractfilepath(tmp)+'INFO') then
1444
      tmp := extractfilepath(tmp)+'INFO';
1445
  end;
1446
  {$ENDIF}
1447
 
1448
  if directoryexists(tmp) then
1449
  begin
1450
    tmp := IncludeTrailingBackslash(tmp);
1451
 
1452
    if fileexists(tmp+'$I'+id) then
1453
    begin
1454
      result := _VistaGetSourceDrive(tmp+'$I'+id);
1455
      exit;
1456
    end
1457
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1458
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1459
  end;
1460
 
1461
  if not fileexists(tmp) then exit;
1462
  if not RecyclerIsValid(tmp) then exit;
1463
 
1464
  fs := TFileStream.Create(tmp, fmOpenRead);
1465
  try
1466
    fs.seek(length_position, soFromBeginning);
1467
    record_length := _readInt32(fs);
1468
 
1469
    i := -1;
1470
    repeat
1471
      inc(i);
1472
      if unique_index_position+i*record_length > fs.size then break;
1473
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
1474
      if inttostr(_readInt32(fs)) = id then
1475
      begin
1476
        fs.seek(source_drive_position+i*record_length, soFromBeginning);
1477
        result := chr(ord('A') + _readInt8(fs));
1478
        break;
1479
      end;
1480
    until false;
1481
  finally
1482
    fs.free;
1483
  end;
1484
end;
1485
 
1486
////////////////////////////////////////////////////////////////////////////////
1487
 
1488
function RecyclerOriginalSize(InfofileOrRecycleFolder: string): integer; overload;
1489
begin
1490
  result := RecyclerOriginalSize(InfofileOrRecycleFolder, '');
1491
end;
1492
 
1493
function RecyclerOriginalSize(drive: char; fileid: string): integer; overload;
1494
begin
1495
  result := RecyclerOriginalSize(drive, '', fileid);
1496
end;
1497
 
1498
function RecyclerOriginalSize(drive: char; UserSID: string; fileid: string): integer; overload;
1499
var
1500
  infofile: string;
1501
begin
1502
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1503
  result := RecyclerOriginalSize(infofile, fileid);
1504
end;
1505
 
1506
function RecyclerOriginalSize(InfofileOrRecycleFolder: string; id: string): integer; overload;
1507
var
1508
  fs: TFileStream;
1509
  i, record_length: integer;
1510
  tmp: string;
1511
const
1512
  length_position = $C;
1513
  unique_index_position = $118;
1514
  original_size_position = $128;
1515
begin
1516
  result := -1;
1517
 
1518
  tmp := InfofileOrRecycleFolder;
1519
 
1520
  if _isFileVistaNamed(tmp) then
1521
  begin
1522
    result := _VistaOriginalSize(tmp);
1523
    exit;
1524
  end;
1525
 
1526
  {$IFDEF allow_all_filenames}
1527
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1528
  begin
1529
    if fileexists(extractfilepath(tmp)+'INFO2') then
1530
      tmp := extractfilepath(tmp)+'INFO2'
1531
    else if fileexists(extractfilepath(tmp)+'INFO') then
1532
      tmp := extractfilepath(tmp)+'INFO';
1533
  end;
1534
  {$ENDIF}
1535
 
1536
  if directoryexists(tmp) then
1537
  begin
1538
    tmp := IncludeTrailingBackslash(tmp);
1539
 
1540
    if fileexists(tmp+'$I'+id) then
1541
    begin
1542
      result := _VistaOriginalSize(tmp+'$I'+id);
1543
      exit;
1544
    end
1545
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1546
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1547
  end;
1548
 
1549
  if not fileexists(tmp) then exit;
1550
  if not RecyclerIsValid(tmp) then exit;
1551
 
1552
  fs := TFileStream.Create(tmp, fmOpenRead);
1553
  try
1554
    fs.seek(length_position, soFromBeginning);
1555
    record_length := _readInt32(fs);
1556
 
1557
    i := -1;
1558
    repeat
1559
      inc(i);
1560
      if unique_index_position+i*record_length > fs.size then break;
1561
      fs.seek(unique_index_position+i*record_length, soFromBeginning);
1562
      if inttostr(_readInt32(fs)) = id then
1563
      begin
1564
        fs.seek(original_size_position+i*record_length, soFromBeginning);
1565
        result := _readInt32(fs);
1566
        break;
1567
      end;
1568
    until false;
1569
  finally
1570
    fs.free;
1571
  end;
1572
end;
1573
 
1574
////////////////////////////////////////////////////////////////////////////////
1575
 
1576
function RecyclerIsValid(drive: char): boolean; overload;
1577
begin
1578
  result := RecyclerIsValid(drive, '');
1579
end;
1580
 
1581
function RecyclerIsValid(drive: char; UserSID: string): boolean; overload;
1582
var
1583
  infofile: string;
1584
begin
1585
  infofile := RecyclerGetPath(drive, UserSID, false);
1586
  result := RecyclerIsValid(infofile);
1587
end;
1588
 
1589
function RecyclerIsValid(InfofileOrRecycleFolder: string): boolean; overload;
1590
var
1591
  tmp: string;
1592
  x: TStringList;
1593
  i: integer;
1594
  eine_fehlerhaft: boolean;
1595
begin
1596
  result := false;
1597
 
1598
  tmp := InfofileOrRecycleFolder;
1599
 
1600
  if _isFileVistaNamed(tmp) then
1601
  begin
1602
    result := _VistaIsValid(tmp);
1603
    exit;
1604
  end;
1605
 
1606
  {$IFDEF allow_all_filenames}
1607
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1608
  begin
1609
    if fileexists(extractfilepath(tmp)+'INFO2') then
1610
      tmp := extractfilepath(tmp)+'INFO2'
1611
    else if fileexists(extractfilepath(tmp)+'INFO') then
1612
      tmp := extractfilepath(tmp)+'INFO';
1613
  end;
1614
  {$ENDIF}
1615
 
1616
  if directoryexists(tmp) then
1617
  begin
1618
    tmp := IncludeTrailingBackslash(tmp);
1619
 
1620
    if fileexists(tmp+'INFO2') then
1621
    begin
1622
      result := _checkInfo1or2File(tmp+'INFO2');
1623
    end;
1624
 
1625
    if not result and fileexists(tmp+'INFO') then
1626
    begin
1627
      result := _checkInfo1or2File(tmp+'INFO');
1628
    end;
1629
 
1630
    if not result then
1631
    begin
1632
      // Complete vista-directory declared?
1633
      eine_fehlerhaft := false;
1634
      x := TStringList.Create;
1635
      try
1636
        _VistaListIndexes(tmp, x);
1637
        for i := 0 to x.Count - 1 do
1638
        begin
1639
          if not _VistaIsValid(tmp+'$I'+x.Strings[i]) then
1640
          begin
1641
            eine_fehlerhaft := true;
1642
          end;
1643
        end;
1644
      finally
1645
        x.Free;
1646
      end;
1647
      result := not eine_fehlerhaft;
1648
    end;
1649
  end;
1650
 
1651
  if not fileexists(tmp) then exit;
1652
 
1653
  result := _checkInfo1or2File(tmp);
1654
end;
1655
 
1656
////////////////////////////////////////////////////////////////////////////////
1657
 
1658
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string): string; overload;
1659
begin
1660
  result := RecyclerCurrentFilename(InfofileOrRecycleFolder, '');
1661
end;
1662
 
1663
function RecyclerCurrentFilename(drive: char; fileid: string): string; overload;
1664
begin
1665
  result := RecyclerCurrentFilename(drive, '', fileid);
1666
end;
1667
 
1668
function RecyclerCurrentFilename(drive: char; UserSID: string; fileid: string): string; overload;
1669
var
1670
  infofile: string;
1671
begin                                                            
1672
  infofile := RecyclerGetPath(drive, UserSID, true, fileid);
1673
  result := RecyclerCurrentFilename(infofile, fileid);
1674
end;
1675
 
1676
function RecyclerCurrentFilename(InfofileOrRecycleFolder: string; id: string): string; overload;
1677
var
1678
  a, c: string;
1679
  tmp: string;
1680
begin
1681
  result := '';
1682
 
1683
  tmp := InfofileOrRecycleFolder;
1684
 
1685
  if _isFileVistaNamed(tmp) then
1686
  begin
1687
    result := _VistaCurrentFilename(tmp);
1688
    exit;
1689
  end;
1690
 
1691
  {$IFDEF allow_all_filenames}
1692
  if not RecyclerIsValid(tmp) and fileexists(tmp) then
1693
  begin
1694
    if fileexists(extractfilepath(tmp)+'INFO2') then
1695
      tmp := extractfilepath(tmp)+'INFO2'
1696
    else if fileexists(extractfilepath(tmp)+'INFO') then
1697
      tmp := extractfilepath(tmp)+'INFO';
1698
  end;
1699
  {$ENDIF}
1700
 
1701
  if directoryexists(tmp) then
1702
  begin
1703
    tmp := IncludeTrailingBackslash(tmp);
1704
 
1705
    if fileexists(tmp+'$I'+id) then
1706
    begin
1707
      result := _VistaCurrentFilename(tmp+'$I'+id);
1708
      exit;
1709
    end
1710
    else if fileexists(tmp+'INFO2') then tmp := tmp+'INFO2'
1711
    else if fileexists(tmp+'INFO') then  tmp := tmp+'INFO';
1712
  end;
1713
 
1714
  a := RecyclerGetSourceDrive(tmp, id);
1715
  c := extractfileext(RecyclerGetSourceUnicode(tmp, id));
1716
  if (a <> '') then
1717
  begin
1718
    result := 'D' + a + id + c;
1719
  end;
1720
end;
1721
 
1722
////////////////////////////////////////////////////////////////////////////////
1723
 
1724
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string): string; overload;
1725
var
1726
  sl: TStringList;
1727
begin
1728
  sl := TStringList.Create;
1729
  try
1730
    RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, fileid, sl);
1731
    if sl.Count > 0 then
1732
      result := ExtractFilePath(sl.Strings[0])
1733
    else
1734
      result := '';
1735
  finally
1736
    sl.free;
1737
  end;
1738
end;
1739
 
1740
function RecyclerGetPath(drive: char; UserSID: string; IncludeInfofile: boolean): string; overload;
1741
var
1742
  sl: TStringList;
1743
begin
1744
  sl := TStringList.Create;
1745
  try
1746
    RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, sl);
1747
    if sl.Count > 0 then
1748
      result := ExtractFilePath(sl.Strings[0])
1749
    else
1750
      result := '';
1751
  finally
1752
    sl.free;
1753
  end;
1754
end;
1755
 
1756
function RecyclerGetPath(drive: char; IncludeInfofile: boolean): string; overload;
1757
var
1758
  sl: TStringList;
1759
begin
1760
  sl := TStringList.Create;
1761
  try
1762
    RecyclerGetInfofiles(drive, IncludeInfofile, sl);
1763
    if sl.Count > 0 then
1764
      result := ExtractFilePath(sl.Strings[0])
1765
    else
1766
      result := '';
1767
  finally
1768
    sl.free;
1769
  end;
1770
end;
1771
 
1772
function RecyclerGetPath(drive: char; UserSID: string): string; overload;
1773
var
1774
  sl: TStringList;
1775
begin
1776
  sl := TStringList.Create;
1777
  try
1778
    RecyclerGetInfofiles(drive, UserSID, sl);
1779
    if sl.Count > 0 then
1780
      result := ExtractFilePath(sl.Strings[0])
1781
    else
1782
      result := '';
1783
  finally
1784
    sl.free;
1785
  end;
1786
end;
1787
 
1788
function RecyclerGetPath(drive: char): string; overload;
1789
var
1790
  sl: TStringList;
1791
begin
1792
  sl := TStringList.Create;
1793
  try
1794
    RecyclerGetInfofiles(drive, sl);
1795
    if sl.Count > 0 then
1796
      result := ExtractFilePath(sl.Strings[0])
1797
    else
1798
      result := '';
1799
  finally
1800
    sl.free;
1801
  end;
1802
end;
1803
 
1804
////////////////////////////////////////////////////////////////////////////////
1805
 
1806
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; fileid: string; result: TStringList); overload;
1807
var
1808
  dir: string;
1809
begin
1810
  (* if Win32Platform = VER_PLATFORM_WIN32_NT then
1811
  begin *)
1812
    if _isVista() then
1813
    begin
1814
      if _isFAT(drive) then
1815
      begin
1816
        dir := drive + DriveDelim + PathDelim + '$recycle.bin' + PathDelim;
1817
        if IncludeInfofile and (fileid <> '') then
1818
        begin
1819
          if fileExists(dir + '$I'+fileid) then
1820
            result.Add(dir + '$I'+fileid);
1821
        end
1822
        else
1823
        begin
1824
          if directoryExists(dir) then
1825
            result.Add(dir);
1826
        end;
1827
      end
1828
      else
1829
      begin
1830
        if UserSID <> '' then
1831
        begin
1832
          dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+UserSID+PathDelim;
1833
          if IncludeInfofile and (fileid <> '') then
1834
          begin
1835
            if fileExists(dir + '$I'+fileid) then
1836
              result.Add(dir + '$I'+fileid);
1837
          end
1838
          else
1839
          begin
1840
            if directoryExists(dir) then
1841
              result.Add(dir);
1842
          end;
1843
        end
1844
        else
1845
        begin
1846
          dir := drive + DriveDelim + PathDelim + '$recycle.bin'+PathDelim+_getMySID()+PathDelim;
1847
          if IncludeInfofile and (fileid <> '') then
1848
          begin
1849
            if fileExists(dir + '$I'+fileid) then
1850
              result.Add(dir + '$I'+fileid);
1851
          end
1852
          else
1853
          begin
1854
            if directoryExists(dir) then
1855
              result.Add(dir);
1856
          end;
1857
        end;
1858
      end;
1859
    end
1860
    else
1861
    begin
1862
      if _isFAT(drive) then
1863
      begin
1864
        dir := drive + DriveDelim + PathDelim + 'Recycled' + PathDelim;
1865
        if IncludeInfofile then
1866
        begin
1867
          // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them)
1868
          if fileExists(dir + 'INFO2') then
1869
            result.Add(dir + 'INFO2'); // Windows 95 with Internet Explorer 4 Extension or higher Windows versions
1870
          if fileExists(dir + 'INFO') then
1871
            result.Add(dir + 'INFO'); // Windows 95 native
1872
        end
1873
        else
1874
        begin
1875
          if directoryExists(dir) then
1876
            result.Add(dir);
1877
        end;
1878
      end
1879
      else
1880
      begin
1881
        if UserSID <> '' then
1882
        begin
1883
          dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+UserSID+PathDelim;
1884
          if IncludeInfofile then
1885
          begin
1886
            if fileExists(dir + 'INFO2') then
1887
              result.Add(dir + 'INFO2');
1888
          end
1889
          else
1890
          begin
1891
            if directoryExists(dir) then
1892
              result.Add(dir);
1893
          end;
1894
        end
1895
        else
1896
        begin
1897
          dir := drive + DriveDelim + PathDelim + 'Recycler'+PathDelim+_getMySID()+PathDelim;
1898
          if IncludeInfofile then
1899
          begin
1900
            if fileExists(dir + 'INFO2') then
1901
              result.Add(dir + 'INFO2');
1902
          end
1903
          else
1904
          begin
1905
            if directoryExists(dir) then
1906
              result.Add(dir);
1907
          end;
1908
        end;
1909
      end;
1910
    end;
1911
  (* end;
1912
  else
1913
  begin
1914
    if isWin95() then
1915
    begin
1916
      result := drive + DriveDelim + PathDelim + 'Recycled' + PathDelim;
1917
      if IncludeInfofile then result := result + 'INFO';
1918
    end
1919
    else
1920
    begin
1921
      result := drive + DriveDelim + PathDelim + 'Recycled' + PathDelim;
1922
      if IncludeInfofile then result := result + 'INFO2';
1923
    end;
1924
  end; *)
1925
end;
1926
 
1927
procedure RecyclerGetInfofiles(drive: char; UserSID: string; IncludeInfofile: boolean; result: TStringList); overload;
1928
begin
1929
  RecyclerGetInfofiles(drive, UserSID, IncludeInfofile, '', result);
1930
end;
1931
 
1932
procedure RecyclerGetInfofiles(drive: char; IncludeInfofile: boolean; result: TStringList); overload;
1933
begin
1934
  RecyclerGetInfofiles(drive, '', IncludeInfofile, '', result);
1935
end;
1936
 
1937
procedure RecyclerGetInfofiles(drive: char; UserSID: string; result: TStringList); overload;
1938
begin
1939
  RecyclerGetInfofiles(drive, UserSID, false, '', result);
1940
end;
1941
 
1942
procedure RecyclerGetInfofiles(drive: char; result: TStringList); overload;
1943
begin
1944
  RecyclerGetInfofiles(drive, '', false, '', result);
1945
end;
1946
 
1947
////////////////////////////////////////////////////////////////////////////////
1948
 
1949
function RecyclerCurrentFilenameAndPath(drive: char; UserSID: string; fileid: string): string; overload;
1950
begin
1951
  result := RecyclerGetPath(drive, UserSID, false, fileid) +
1952
    RecyclerCurrentFilename(drive, UserSID, fileid);
1953
end;
1954
 
1955
function RecyclerCurrentFilenameAndPath(drive: char; fileid: string): string; overload;
1956
begin
1957
  result := RecyclerCurrentFilenameAndPath(drive, '', fileid);
1958
end;
1959
 
1960
function RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder: string; id: string): string; overload;
1961
begin
1962
  if RecyclerIsValid(InfofileOrRecycleFolder) then
1963
  begin
1964
    result := extractfilepath(InfofileOrRecycleFolder) +
1965
      RecyclerCurrentFilename(InfofileOrRecycleFolder, id);
1966
  end
1967
  else
1968
    result := '';
1969
end;
1970
 
1971
////////////////////////////////////////////////////////////////////////////////
1972
 
1973
function RecyclerRemoveItem(drive: char; UserSID: string; fileid: string): boolean; overload;
1974
var
1975
  tmp: string;
1976
begin
1977
  tmp := RecyclerCurrentFilenameAndPath(drive, UserSID, fileid);
1978
  if fileexists(tmp) then
1979
  begin
1980
    deletefile(tmp);
1981
    result := fileexists(tmp);
1982
  end
1983
  else
1984
  begin
1985
    directoryexists(tmp);
1986
    result := directoryexists(tmp);
1987
  end;
1988
end;
1989
 
1990
function RecyclerRemoveItem(drive: char; fileid: string): boolean; overload;
1991
begin
1992
  result := RecyclerRemoveItem(drive, '', fileid);
1993
end;
1994
 
1995
function RecyclerRemoveItem(InfofileOrRecycleFolder: string; id: string): boolean; overload;
1996
var
1997
  tmp: string;
1998
begin
1999
  tmp := RecyclerCurrentFilenameAndPath(InfofileOrRecycleFolder, id);
2000
  if fileexists(tmp) then
2001
  begin
2002
    deletefile(tmp);
2003
    result := fileexists(tmp);
2004
  end
2005
  else
2006
  begin
2007
    directoryexists(tmp);
2008
    result := directoryexists(tmp);
2009
  end;
2010
end;
2011
 
2012
procedure RecyclerGetAllRecyclerDrives(result: TStringList);
2013
var
2014
  x: char;
2015
begin
2016
  for x := 'C' to 'Z' do
2017
  begin
2018
    if RecyclerIsValid(x) then
2019
    begin
2020
      result.Add(x);
2021
    end;
2022
  end;
2023
end;
2024
 
2025
////////////////////////////////////////////////////////////////////////////////
2026
 
2027
// http://www.dsdt.info/tipps/?id=176
2028
function RecyclerEmptyRecycleBin(flags: cardinal): boolean; overload;
2029
type
2030
  TSHEmptyRecycleBin = function (Wnd: HWND;
2031
                                 pszRootPath: PChar;
2032
                                 dwFlags: DWORD):
2033
                                 HRESULT; stdcall;
2034
var
2035
  PSHEmptyRecycleBin: TSHEmptyRecycleBin;
2036
  LibHandle: THandle;
2037
const
2038
  C_SHEmptyRecycleBinA = 'SHEmptyRecycleBinA';
2039
begin
2040
  result := true;
2041
  LibHandle := LoadLibrary(shell32) ;
2042
  try
2043
    if LibHandle <> 0 then
2044
    begin
2045
      @PSHEmptyRecycleBin:= GetProcAddress(LibHandle, C_SHEmptyRecycleBinA);
2046
      if @PSHEmptyRecycleBin <> nil then
2047
      begin
2048
        PSHEmptyRecycleBin(hInstance, nil, flags);
2049
      end
2050
      else
2051
        result := false;
2052
    end
2053
    else
2054
      result := false;
2055
  finally
2056
    @PSHEmptyRecycleBin := nil;
2057
    FreeLibrary(LibHandle);
2058
  end;
2059
end;
2060
 
2061
function RecyclerEmptyRecycleBin(sound, progress, confirmation: boolean): boolean; overload;
2062
const
2063
  SHERB_NOCONFIRMATION = $00000001;
2064
  SHERB_NOPROGRESSUI   = $00000002;
2065
  SHERB_NOSOUND        = $00000004;
2066
var
2067
  flags: cardinal;
2068
begin
2069
  flags := 0;
2070
 
2071
  if not progress then
2072
    flags := flags or SHERB_NOPROGRESSUI;
2073
  if not confirmation then
2074
    flags := flags or SHERB_NOCONFIRMATION;
2075
  if not sound then
2076
    flags := flags or SHERB_NOSOUND;
2077
 
2078
  result := RecyclerEmptyRecycleBin(flags);
2079
end;
2080
 
2081
////////////////////////////////////////////////////////////////////////////////
2082
 
2083
// Template
2084
// http://www.dsdt.info/tipps/?id=116
2085
function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean): boolean; overload;
2086
var
2087
  Operation: TSHFileOpStruct;
2088
begin
2089
  with Operation do
2090
  begin
2091
    Wnd := hInstance; // OK?
2092
    wFunc := FO_DELETE;
2093
    pFrom := PChar(FileOrFolder + #0);
2094
    pTo := nil;
2095
    fFlags := FOF_ALLOWUNDO;
2096
    if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
2097
  end;
2098
  Result := SHFileOperation(Operation) = 0;
2099
end;
2100
 
2101
function RecyclerAddFileOrFolder(FileOrFolder: string): boolean; overload;
2102
begin
2103
  result := RecyclerAddFileOrFolder(FileOrFolder, false);
2104
end;
2105
 
2106
function RecyclerConfirmationDialogEnabled: boolean;
17 daniel-mar 2107
var
2108
  gp: GPOLICYBOOL;
2109
begin
2110
  gp := RecyclerGroupPolicyConfirmFileDelete;
2111
  if gp <> gpUndefined then
2112
  begin
2113
    result := gp = gpEnabled;
2114
  end
2115
  else
2116
  begin
2117
    result := RecyclerShellStateConfirmationDialogEnabled;
2118
  end;
2119
end;
2120
 
2121
function RecyclerShellStateConfirmationDialogEnabled: boolean;
12 daniel-mar 2122
type
2123
  TSHGetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD) stdcall;
2124
const
2125
  C_SHGetSettings = 'SHGetSettings';
2126
var
2127
  lpss: SHELLSTATE;
2128
  bNoConfirmRecycle: boolean;
2129
 
2130
  PSHGetSettings: TSHGetSettings;
2131
  RBHandle: THandle;
2132
 
2133
  reg: TRegistry;
2134
  rbuf: array[0..255] of byte;
2135
begin
2136
  PSHGetSettings := nil;
2137
  result := false; // Avoid warning message
2138
 
2139
  RBHandle := LoadLibrary(shell32);
2140
  if(RBHandle <> 0) then
2141
  begin
2142
    PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings);
2143
    if (@PSHGetSettings = nil) then
2144
    begin
2145
      FreeLibrary(RBHandle);
2146
      RBHandle := 0;
2147
    end;
2148
  end;
2149
 
2150
  if (RBHandle <> 0) and (Assigned(PSHGetSettings)) then
2151
  begin
2152
    ZeroMemory(@lpss, SizeOf(lpss));
2153
    PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE);
2154
    // bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle
2155
    bNoConfirmRecycle := GetByteBit(lpss.Flags1, 2);
2156
 
2157
    result := not bNoConfirmRecycle;
2158
  end
2159
  else
2160
  begin
2161
    reg := TRegistry.Create;
2162
    try
2163
      // API function call failed. Probably because Windows is too old.
2164
      // Try to read out from registry.
16 daniel-mar 2165
      // The 3rd bit of the 5th byte of "ShellState" is the value
2166
      // of "fNoConfirmRecycle".
12 daniel-mar 2167
 
2168
      reg.RootKey := HKEY_CURRENT_USER;
2169
      if (reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer')) then
2170
      begin
2171
        ZeroMemory(@rbuf, SizeOf(rbuf));
2172
        reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf));
2173
 
2174
        // Lese 3tes Bit vom 5ten Byte
2175
        // bNoConfirmRecycle := ((rbuf[4] and 4) = 4);
2176
        bNoConfirmRecycle := GetByteBit(ord(rbuf[4]), 2);
2177
        result := not bNoConfirmRecycle;
2178
 
2179
        reg.CloseKey;
2180
      end
2181
      else
2182
      begin
2183
        raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]);
2184
      end;
2185
    finally
2186
      reg.Free;
2187
    end;
2188
  end;
2189
 
2190
  if (RBHandle <> 0) then FreeLibrary(RBHandle);
2191
end;
2192
 
2193
procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean);
2194
type
2195
  TSHGetSetSettings = procedure (var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL) stdcall;
2196
const
2197
  C_SHGetSetSettings = 'SHGetSetSettings';
2198
var
2199
  lpss: SHELLSTATE;
2200
 
2201
  PSHGetSetSettings: TSHGetSetSettings;
2202
  RBHandle: THandle;
2203
 
2204
  reg: TRegistry;
2205
  rbuf: array[0..255] of byte;
2206
 
2207
  dwResult: DWORD;
2208
begin
2209
  PSHGetSetSettings := nil;
2210
 
2211
  RBHandle := LoadLibrary(shell32);
2212
  if(RBHandle <> 0) then
2213
  begin
2214
    PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
2215
    if (@PSHGetSetSettings = nil) then
2216
    begin
2217
      FreeLibrary(RBHandle);
2218
      RBHandle := 0;
2219
    end;
2220
  end;
2221
 
2222
  if (RBHandle <> 0) and (Assigned(PSHGetSetSettings)) then
2223
  begin
2224
    ZeroMemory(@lpss, SizeOf(lpss));
2225
    PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get
2226
    lpss.Flags1 := SetByteBit(lpss.Flags1, 2, NewSetting);
2227
    PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
2228
 
2229
    // TODO: Do we need a WM_SETTINGCHANGE message to send?
2230
    SendMessageTimeout (
2231
      HWND_BROADCAST, WM_SETTINGCHANGE,
2232
      0, lParam (pChar ('Environment')),
2233
      SMTO_ABORTIFHUNG, 5000, dwResult
2234
    );
2235
  end
2236
  else
2237
  begin
2238
    reg := TRegistry.Create;
2239
    try
2240
      // API function call failed. Probably because Windows is too old.
2241
      // Try to read out from registry.
16 daniel-mar 2242
      // The 3rd bit of the 5th byte of "ShellState" is the value
2243
      // of "fNoConfirmRecycle".
12 daniel-mar 2244
 
2245
      reg.RootKey := HKEY_CURRENT_USER;
2246
      if (reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false)) then
2247
      begin
2248
        ZeroMemory(@rbuf, SizeOf(rbuf));
2249
        reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get
2250
        rbuf[4] := SetByteBit(rbuf[4], 2, NewSetting);
2251
        reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
2252
 
2253
        // TODO: Check if that's OK...
2254
        SendMessageTimeout (
2255
          HWND_BROADCAST, WM_SETTINGCHANGE,
2256
          0, lParam (pChar ('Environment')),
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
3022
        result := reg.ReadInteger('RecycleBinSize');
3023
      reg.CloseKey;
3024
    end;
3025
  finally
3026
    reg.Free;
3027
  end;
3028
end;
3029
 
3030
function GPBoolToString(value: GPOLICYBOOL): String;
3031
begin
3032
  case value of
3033
    gpUndefined: result := 'Not configured';
3034
    gpEnabled: result := 'Enabled';
3035
    gpDisabled: result := 'Disabled';
3036
  end;
3037
end;
3038
 
12 daniel-mar 3039
function RecyclerLibraryVersion: string;
3040
begin
17 daniel-mar 3041
  result := 'ViaThinkSoft Recycle Bin Unit [18 JUN 2010]';
12 daniel-mar 3042
end;
3043
 
3044
end.