Subversion Repositories recyclebinunit

Rev

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

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