Subversion Repositories recyclebinunit

Rev

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

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