Subversion Repositories recyclebinunit

unit RecBinUnit2 platform;

////////////////////////////////////////////////////////////////////////////////////

// RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT                          //

// E-MAIL: info@daniel-marschall.de                                               //

// Web:    www.daniel-marschall.de & www.viathinksoft.de                          //

////////////////////////////////////////////////////////////////////////////////////

// Revision: 30 JUN 2022                                                          //

// This unit is freeware, but please link to my website if you are using it!      //

////////////////////////////////////////////////////////////////////////////////////

// Successfully tested with:                                                      //

// Windows 95b (without IE4 Shell Extensions)                                     //

// Windows 95b (with IE4 Shell Extensions)                                        //

// Windows 98 SE                                                                  //

// Windows NT4 SP6                                                                //

// Windows XP SP3                                                                 //

// Windows 2000 SP4                                                               //

// Windows 2003 Server EE SP1                                                     //

// Windows Vista                                                                  //

// Windows 7                                                                      //

// Windows 10 (version 1 and version 2 format)                                    //

// Windows 11                                                                     //

////////////////////////////////////////////////////////////////////////////////////

// Delphi 7 Compatibility:  (TODO: compiler switches)

// - Remove "static"

// - Remove "strict"

// - Remove "$REGION"

// TODO: ReadBuffer überall try-except

// TODO: Always check EOF before reading anything?

// TODO: Don't crash when timestamp is invalid. Do something else instead.

// TODO: Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext?

// TODO: RecyclerGetInfofiles() check additionally for removable device?

//       RecyclerIsValid() is false.

// TODO: Make it possible to empty the recycle bin of one specific drive!

// TODO: Unknown! Do you know the answer?

//       - How does Windows 9x/NT manage the daylight saving time (if it does)?

//       - How does Windows Vista+ react to a RECYCLER\ folder on a NTFS device?

//       - How does Windows Vista+ react to a RECYCLED\ folder on a FAT device? ==> Win7: is ignored!

//       - How does Windows XP react to RECYCLED\ folder on a FAT device?

// TODO: Translate all comments from German to English

// TODO: Do we need this (maybe not all drives have A: till Z:?) http://stackoverflow.com/questions/17110543/how-to-retrieve-the-disk-signature-of-all-the-disks-in-windows-using-delphi-7

// TODO: Add a lot of setters for system config stuff

// If enabled, the deletion timestamps will not be converted by the WinAPI.

{.$DEFINE FILETIME_DELPHI_CODE}

// If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, even if gpedit.msc shows "Not configured"!

{$DEFINE GroupPolicyAcceptHKLMTrick}

interface

uses

  Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;

const

  RECBINUNIT_VERSION = '2022-06-30';

  RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';

  NULL_GUID:      TGUID = '{00000000-0000-0000-0000-000000000000}';

type

  EAPICallError = class(Exception);

  EEventCategoryNotDefined = class(Exception);

  EInvalidDrive = class(Exception);

  PSHQueryRBInfo = ^TSHQueryRBInfo;

  {$IFDEF WIN64}

  // ATTENTION! MUST NOT BE PACKED! Alignment for 64 bit must be 8 and for 32 bit must be 4

  TSHQueryRBInfo = record

  {$ELSE}

  TSHQueryRBInfo = packed record

  {$ENDIF}

    cbSize      : DWORD;

    i64Size     : int64;

    i64NumItems : int64;

  end;

  TRbRecycleBinItem = class(TObject)

  strict private

    function GetSource: string;

  strict protected

    FSourceAnsi: AnsiString;

    FSourceUnicode: WideString;

    FID: string;

    FSourceDrive: Char;

    FDeletionTime: TDateTime;

    FOriginalSize: int64;

    FIndexFile: string;

    FRemovedEntry: boolean;

    procedure ReadFromStream(stream: TStream); virtual; abstract;

    function GetPhysicalFile: string; virtual; abstract; // protected, because it will be read by "property"

  public

    property PhysicalFile: string read GetPhysicalFile;

    property SourceAnsi: AnsiString read FSourceAnsi;

    property SourceUnicode: WideString read FSourceUnicode;

    property Source: string read GetSource; // will bei either ANSI or Unicode, depending on the Delphi version

    property ID: string read FID;

    property SourceDrive: Char read FSourceDrive;

    property DeletionTime: TDateTime read FDeletionTime;

    property OriginalSize: int64 read FOriginalSize;

    property IndexFile: string read FIndexFile;

    property RemovedEntry: boolean read FRemovedEntry; // the file is NOT in the recycle bin anymore!

    // Attention: There are no official API calls. The delete and recover

    // functions might fail and/or damage the shell cache. Handle with care!

    function DeleteFile: boolean; virtual; abstract;

    function RecoverFile: boolean; virtual; abstract;

    function OpenFile: boolean; virtual; abstract;

  end;

  TRbInfoAItem = class(TRbRecycleBinItem)

  strict protected

    procedure ReadFromStream(stream: TStream); override;

    function GetPhysicalFile: string; override;

  public

    constructor Create(fs: TStream; AIndexFile: string);

    function DeleteFile: boolean; override;

    // TODO: function RecoverFile: boolean; override;

    // TODO: function OpenFile: boolean; override;

  end;

  TRbInfoWItem = class(TRbRecycleBinItem)

  strict protected

    procedure ReadFromStream(stream: TStream); override;

    function GetPhysicalFile: string; override;

  public

    constructor Create(fs: TStream; AIndexFile: string);

    function DeleteFile: boolean; override;

    // TODO: function RecoverFile: boolean; override;

    // TODO: function OpenFile: boolean; override;

  end;

  TRbVistaItem = class(TRbRecycleBinItem)

  strict protected

    procedure ReadFromStream(stream: TStream); override;

    function GetPhysicalFile: string; override;

  public

    constructor Create(fs: TStream; AIndexFile, AID: string);

    function DeleteFile: boolean; override;

    // TODO: function RecoverFile: boolean; override;

    // TODO: function OpenFile: boolean; override;

  end;

  TRbRecycleBin = class(TObject)

  strict private

    FFileOrDirectory: string;

    FSID: string;

    FTolerantReading: boolean;

  public

    constructor Create(AFileOrDirectory: string; ASID: string='');

    function GetItem(id: string): TRbRecycleBinItem;

    procedure ListItems(list: TObjectList{TRbRecycleBinItem});

    function CheckIndexes(slErrors: TStrings): boolean;

    property FileOrDirectory: string read FFileOrDirectory;

    property SID: string read FSID;

    // Allows an index file to be read, even if an incompatible multiboot combination

    // corrupted it. Default: true.

    property TolerantReading: boolean read FTolerantReading write FTolerantReading;

  end;

  // TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind?

  TRbDrive = class(TObject)

  strict private

    FDriveLetter: AnsiChar;

    function OldCapacityPercent(var res: integer): boolean; // in % (0-100)

    function NewCapacityAbsolute(var res: integer): boolean; // in MB

    function DiskSize: integer; // in MB

    function DriveNumber: integer;

  strict protected

    function IsFAT: boolean;

    procedure CheckDriveExisting;

    // will return NULL_GUID in case of an error or if it is not supported

    function GetVolumeGUID: TGUID;

    function GetVolumeGUIDAvailable: boolean;

    // TODO: get drive serial

  public

    constructor Create(ADriveLetter: AnsiChar);

    // Wenn UserSID='', dann werden alle Recycler gefunden

    procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');

    property DriveLetter: AnsiChar read FDriveLetter;

    property VolumeGUID: TGUID read GetVolumeGUID;

    property VolumeGUIDAvailable: boolean read GetVolumeGUIDAvailable;

    function GetAPIInfo: TSHQueryRBInfo;

    function GetSize: int64;

    function GetNumItems: int64;

    function IsEmpty: boolean;

    function GetMaxPercentUsage: Extended; // 0..1

    function GetMaxAbsoluteUsage: integer; // in MB

    function GetNukeOnDelete: boolean;

  end;

  GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);

  TRecycleBinManager = class(TObject)

  public

    class procedure ListDrives(list: TObjectList{TRbDrive}); static;

    class function RecycleBinPossible(Drive: AnsiChar): boolean; static;

    class function OwnRecyclersSize: int64; static;

    class function OwnRecyclersNumItems: int64; static;

    class function OwnRecyclersEmpty: boolean; static;

    class function EmptyOwnRecyclers(flags: cardinal): boolean; overload; static;

    class function EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean; overload; static;

    class function RecyclerGetCurrentIconString: string; static;

    class function RecyclerGetDefaultIconString: string; static;

    class function RecyclerGetEmptyIconString: string; static;

    class function RecyclerGetFullIconString: string; static;

    class function GetGlobalMaxPercentUsage: integer; static; // TODO: In Win Vista: absolute and not relative sizes

    class function GetGlobalNukeOnDelete: boolean; static;

    class function UsesGlobalSettings: boolean; static;

    class function RecyclerGetName: string; static;

    class function RecyclerGetInfoTip: string; static;

    class function RecyclerGetIntroText: string; static;

    class function RecyclerEmptyEventGetCurrentSound: string; static;

    class function RecyclerEmptyEventGetDefaultSound: string; static;

    class function RecyclerEmptyEventGetName: string; static;

    class function RecyclerEmptyEventGetSound(ACategory: string): string; static;

    class procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList); static;

    // TODO: In future also detect for other users

    // TODO: Also make a setter (incl. Message to Windows Explorer?)

    class function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL; static;

    class function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL; static;

    class function RecyclerGroupPolicyRecycleBinSize: integer; static;

    class function RecyclerConfirmationDialogEnabled: boolean; static;

    class procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean); static;

    class function RecyclerShellStateConfirmationDialogEnabled: boolean; static;

    // Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer

    // 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben

    // werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da

    // unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind:

    // - RecyclerIsEmpty

    // - RecyclerGetNumItems

    // - RecyclerGetSize

    // - RecyclerGetAPIInfo

    class function RecyclerQueryFunctionAvailable: boolean; static;

    class function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean; static;

  end;

function GPBoolToString(value: GPOLICYBOOL): string;

implementation

uses

  RecBinUnitLowLvl;

{$REGION 'WinAPI/RTL declarations'}

(*

const

  {$IFDEF MSWINDOWS}

    shell32  = 'shell32.dll';

    advapi32 = 'advapi32.dll';

    kernel32 = 'kernel32.dll';

  {$ENDIF}

  {$IFDEF LINUX}

    shell32  = 'libshell32.borland.so';

    advapi32 = 'libwine.borland.so';

    kernel32 = 'libwine.borland.so';

  {$ENDIF}

*)

type

  SHELLSTATE = record

    Flags1: DWORD;

(*

    BOOL fShowAllObjects : 1;

    BOOL fShowExtensions : 1;

    BOOL fNoConfirmRecycle : 1;

    BOOL fShowSysFiles : 1;

    BOOL fShowCompColor : 1;

    BOOL fDoubleClickInWebView : 1;

    BOOL fDesktopHTML : 1;

    BOOL fWin95Classic : 1;

    BOOL fDontPrettyPath : 1;

    BOOL fShowAttribCol : 1; // No longer used, dead bit

    BOOL fMapNetDrvBtn : 1;

    BOOL fShowInfoTip : 1;

    BOOL fHideIcons : 1;

    BOOL fWebView : 1;

    BOOL fFilter : 1;

    BOOL fShowSuperHidden : 1;

    BOOL fNoNetCrawling : 1;

*)

    dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts

    uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts

    // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM

    lParamSort: Integer;

    iSortDirection: Integer;

    version: UINT;

    // new for win2k. need notUsed var to calc the right size of ie4 struct

    // FIELD_OFFSET does not work on bit fields

    uNotUsed: UINT; // feel free to rename and use

    Flags2: DWORD;

(*

    BOOL fSepProcess: 1;

    // new for Whistler.

    BOOL fStartPanelOn: 1;       //Indicates if the Whistler StartPanel mode is ON or OFF.

    BOOL fShowStartPage: 1;      //Indicates if the Whistler StartPage on desktop is ON or OFF.

    UINT fSpareFlags : 13;

*)

  end;

  LPSHELLSTATE = ^SHELLSTATE;

const

  // Masks for the SHELLSTATE

  SSF_SHOWALLOBJECTS       = $00000001;

  SSF_SHOWEXTENSIONS       = $00000002;

  SSF_HIDDENFILEEXTS       = $00000004;

  SSF_SERVERADMINUI        = $00000004;

  SSF_SHOWCOMPCOLOR        = $00000008;

  SSF_SORTCOLUMNS          = $00000010;

  SSF_SHOWSYSFILES         = $00000020;

  SSF_DOUBLECLICKINWEBVIEW = $00000080;

  SSF_SHOWATTRIBCOL        = $00000100;

  SSF_DESKTOPHTML          = $00000200;

  SSF_WIN95CLASSIC         = $00000400;

  SSF_DONTPRETTYPATH       = $00000800;

  SSF_SHOWINFOTIP          = $00002000;

  SSF_MAPNETDRVBUTTON      = $00001000;

  SSF_NOCONFIRMRECYCLE     = $00008000;

  SSF_HIDEICONS            = $00004000;

  SSF_FILTER               = $00010000;

  SSF_WEBVIEW              = $00020000;

  SSF_SHOWSUPERHIDDEN      = $00040000;

  SSF_SEPPROCESS           = $00080000;

  SSF_NONETCRAWLING        = $00100000;

  SSF_STARTPANELON         = $00200000;

  SSF_SHOWSTARTPAGE        = $00400000;

{$ENDREGION}

resourcestring

  LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".';

  LNG_NOT_CALLABLE = '%s not callable';

  LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s';

  LNG_FILE_NOT_FOUND = 'File not found: %s';

  LNG_INVALID_INFO_FORMAT = 'Unexpected record size: %s';

  LNG_DRIVE_NOT_EXISTING = 'Drive %s does not exist.';

const

  {$IFDEF UNICODE}

  C_SHEmptyRecycleBin = 'SHEmptyRecycleBinW';

  C_SHQueryRecycleBin = 'SHQueryRecycleBinW';

  C_GetVolumeNameForVolumeMountPoint = 'GetVolumeNameForVolumeMountPointW';

  {$ELSE}

  C_SHEmptyRecycleBin = 'SHEmptyRecycleBinA';

  C_SHQueryRecycleBin = 'SHQueryRecycleBinA';

  C_GetVolumeNameForVolumeMountPoint = 'GetVolumeNameForVolumeMountPointA';

  {$ENDIF}

  C_SHGetSettings = 'SHGetSettings';

  C_SHGetSetSettings = 'SHGetSetSettings';

type

  TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

  TGetVolumeNameForVolumeMountPoint = function(lpszVolumeMountPoint: LPCTSTR; lpszVolumeName: LPTSTR; cchBufferLength: DWORD): BOOL; stdcall;

  TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: LPCTSTR; dwFlags: DWORD): HRESULT; stdcall;

  TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD); stdcall;

  TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL); stdcall;

function WideCharArrayToWideString(x: array of WideChar): WideString;

var

  i: integer;

begin

  // In x86, the "cast" works with WideString.

  // In x64, it does not work (outputs empty string, without compiler warning!)

  // So, we created this fake-cast

  SetLength(result, Length(x));

  for i := 0 to Length(x)-1 do

    result[i+1] := x[i];

end;

function AnsiCharArrayToWideString(x: array of AnsiChar): WideString;

var

  i: integer;

begin

  SetLength(result, Length(x));

  for i := 0 to Length(x)-1 do

    result[i+1] := WideChar(x[i]);

end;

procedure AnsiRemoveNulChars(var s: AnsiString);

begin

  while (Length(s) > 0) and (s[Length(s)] = #0) do

    s := Copy(s, 1, Length(s)-1);

end;

procedure UnicodeRemoveNulChars(var s: WideString);

begin

  while (Length(s) > 0) and (s[Length(s)] = #0) do

    s := Copy(s, 1, Length(s)-1);

end;

function GetDriveGUID(driveLetter: AnsiChar; var guid: TGUID): DWORD;

var

  Buffer: array[0..50] of Char;

  x: string;

  PGetVolumeNameForVolumeMountPoint: TGetVolumeNameForVolumeMountPoint;

  RBHandle: THandle;

begin

  RBHandle := LoadLibrary(kernel32);

  try

    if RBHandle <> 0 then

    begin

      PGetVolumeNameForVolumeMountPoint := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);

      if not Assigned(@PGetVolumeNameForVolumeMountPoint) then

      begin

        result := GetLastError;

        FreeLibrary(RBHandle);

        RBHandle := 0;

      end

      else

      begin

        if PGetVolumeNameForVolumeMountPoint(PChar(driveLetter+':\'), Buffer, SizeOf(Buffer)) then

        begin

          x := string(buffer);

          x := copy(x, 11, 38);

          guid := StringToGUID(x);

          result := ERROR_SUCCESS;

        end

        else

          result := GetLastError;

      end;

    end

    else result := GetLastError;

  finally

    if RBHandle <> 0 then FreeLibrary(RBHandle);

  end;

end;

function FileTimeToDateTime(FileTime: FILETIME): TDateTime;

{$IFDEF FILETIME_DELPHI_CODE}

var

  SystemTime: TSystemTime;

  nowUTC: TDateTime;

  gmtDifference: int64;

begin

  GetSystemTime(SystemTime);

  with SystemTime do

  begin

    // http://www.delphipraxis.net/post340194.html#34019

    nowUTC := EncodeDate(wYear, wMonth, wDay) +

              EncodeTime(wHour, wMinute, wSecond, wMilliseconds);

  end;

  gmtDifference := datetimetounix(nowUTC) - datetimetounix(Now);

  // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf states:

  // UnixTime = 0.0000001 * NTTime + 11644473600

  // This is wrong! The correct formula is:

  // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600

  // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds)

  result := unixtodatetime(round(0.0000001 * int64(FileTime)) - 11644473600 - gmtDifference);

{$ELSE}

var

  LocalTime: TFileTime;

  DOSTime: Integer;

begin

  FileTimeToLocalFileTime(FileTime, LocalTime);

  FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo);

  Result := FileDateToDateTime(DOSTime);

{$ENDIF}

end;

function DeleteDirectory(const Name: string): boolean;

var

  F: TSearchRec;

begin

  result := true;

  if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then

  begin

    try

      repeat

        if F.Attr and faDirectory <> 0 then

        begin

          if (F.Name <> '.') and (F.Name <> '..') then

          begin

            result := result and DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name);

          end;

        end

        else

        begin

          if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false;

        end;

      until FindNext(F) <> 0;

    finally

      FindClose(F);

    end;

    if not RemoveDir(Name) then result := false;

  end;

end;

function DriveLetterToDriveNumber(driveLetter: AnsiChar): integer;

var

  tmp: string;

begin

  tmp := LowerCase(string(driveLetter));

  result := Ord(tmp[1])-Ord('a');

end;

function GetStringFromDLL(filename: string; num: integer): string;

const

  // Source: http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp

  MAX_BUF = 4097; // OK?

var

  hLib: THandle;

  buf: array[0..MAX_BUF] of char;

begin

  hLib := LoadLibrary(PChar(filename));

  try

    LoadString(hLib, num, buf, sizeof(buf));

    result := buf;

  finally

    FreeLibrary(hLib);

  end;

end;

function ExpandEnvStr(const szInput: string): string;

const

  MAXSIZE = 32768; // laut PSDK sind 32k das Maximum

begin

  // Source: http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html

  SetLength(Result,MAXSIZE);

  SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),

    @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen

end;

function DecodeReferenceString(s: string): string;

var

  dll, id, lang, cache: string;

  sl, sl2: tstringlist;

begin

  // Beispiele

  // Papierkorb                                                 -- Windows 95

  // @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb       -- Windows 2000

  if Copy(s, 1, 1) = '@' then

  begin

    // Referenz auf eine DLL

    // @<dll>,-<id>[@<lang>][,<cache>]

    sl := TStringList.Create;

    try

      // '@' am Anfang entfernen

      s := Copy(s, 2, length(s)-1);

      // Nach ',' auftrennen

      // sl[0] --> dll

      // sl[1] --> -id@lang

      // sl[2] --> cache

      sl.CommaText := s;

      if sl.Count > 2 then

      begin

        // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden

        // Ist bei Windows 2000 der Fall

        cache := sl[2];

        result := cache;

        exit;

      end;

      if sl.Count > 1 then

      begin

        dll := sl[0];

        sl2 := TStringList.Create;

        try

          // Nach '@' auftrennen

          // sl2[0] --> id

          // sl2[1] --> lang

          sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]);

          id := sl2[0];

          if sl2.Count > 1 then

          begin

            // ToDo: In Zukunft beachten, sofern möglich

            lang := sl2[1];

          end;

          // Umgebungsvariablen erkennen und Minuszeichen entfernen

          result := GetStringFromDLL(ExpandEnvStr(dll), -StrToInt(id));

        finally

          sl2.Free;

        end;

      end

      else

      begin

        // Zu wenige Informationen!

        result := '';

      end;

    finally

      sl.Free;

    end;

  end

  else

  begin

    // Kein Hinweis auf eine Referenz

    result := s;

  end;

end;

function GPBoolToString(value: GPOLICYBOOL): string;

begin

  case value of

    gpUndefined: result := 'Not configured';

    gpEnabled: result := 'Enabled';

    gpDisabled: result := 'Disabled';

  end;

end;

{ TRbRecycleBin }

constructor TRbRecycleBin.Create(AFileOrDirectory: string; ASID: string='');

begin

  inherited Create;

  FFileOrDirectory := AFileOrDirectory;

  FSID := ASID;

  TolerantReading := true;

end;

// TODO: also a function that tests if the data files are still existing

function TRbRecycleBin.CheckIndexes(slErrors: TStrings): boolean;

  procedure _Assert(assertion: boolean; msg: string; args: array of const);

  begin

    if not assertion then

    begin

      slErrors.Add(Format(msg, args));

      result := false;

    end;

  end;

  procedure _HandleIndexFile(AFile: string);

  var

    fs: TFileStream;

    infoHdr: TRbInfoHeader;

  resourcestring

    LNG_IDXERR_VISTA_FILESIZE = '%s: Vista index file has wrong size';

    LNG_IDXERR_INFO_RECSIZE_UNEXPECTED = '%s: record size unexpected';

    LNG_IDXERR_INFO_UNEXPECTED_EOF = '%s: file size wrong';

  begin

    fs := TFileStream.Create(AFile, fmOpenRead);

    try

      fs.Seek(0, soFromBeginning);

      if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then

      begin

        _Assert(fs.Size = SizeOf(TRbVistaItem), LNG_IDXERR_VISTA_FILESIZE, [AFile]);

      end

      else if SameText(ExtractFileName(AFile), 'INFO') or

              SameText(ExtractFileName(AFile), 'INFO2') then

      begin

        fs.ReadBuffer(infoHdr, SizeOf(infoHdr));

        _Assert((infoHdr.recordLength = SizeOf(TRbInfoRecordA)) or

                (infoHdr.recordLength = SizeOf(TRbInfoRecordW)), LNG_IDXERR_INFO_RECSIZE_UNEXPECTED, [AFile]);

        _Assert((fs.Size-fs.Position) mod infoHdr.recordLength = 0, LNG_IDXERR_INFO_UNEXPECTED_EOF, [AFile]);

        // TODO: we can also check infoHdr.totalSize or infoHdr.totalEntries

      end

      else Assert(false);

      // TODO: we could check each item for invalid stuff...?

    finally

      FreeAndNil(fs);

    end;

  end;

  procedure _HandleVistaDir(ADirectory: string);

  var

    SR: TSearchRec;

  begin

    ADirectory := IncludeTrailingPathDelimiter(ADirectory);

    if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then

    begin

      repeat

        _HandleIndexFile(ADirectory+sr.Name);

      until FindNext(SR) <> 0;

    end;

    FindClose(SR);

  end;

begin

  result := true;

  if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2

  begin

    _HandleVistaDir(FFileOrDirectory);

    if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then

    begin

      _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2');

    end;

    if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then

    begin

      _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO');

    end;

  end

  else if FileExists(FFileOrDirectory) then

  begin

    _HandleIndexFile(FFileOrDirectory);

  end

  else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]);

end;

function TRbRecycleBin.GetItem(id: string): TRbRecycleBinItem;

  procedure _HandleIndexFile(AFile: string);

  var

    fs: TFileStream;

    infoHdr: TRbInfoHeader;

    testItem: TRbRecycleBinItem;

  begin

    fs := TFileStream.Create(AFile, fmOpenRead);

    try

      fs.Seek(0, soFromBeginning);

      if SameText(ExtractFileName(AFile), '$I'+id) then

      begin

        result := TRbVistaItem.Create(fs, AFile, id);

      end

      else

      begin

        fs.ReadBuffer(infoHdr, SizeOf(infoHdr));

        case infoHdr.recordLength of

          SizeOf(TRbInfoRecordA):

          begin

            while fs.Position < fs.size do

            begin

              testItem := TRbInfoAItem.Create(fs, AFile);

              if testItem.ID = id then

              begin

                result := testItem;

                break;

              end;

            end;