WebSVN – recyclebinunit – Diff – /trunk/Recycle Bin Unit v2/RecBinUnit2.pas



////////////////////////////////////////////////////////////////////////////////////
// RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT                          //
// E-MAIL: info@daniel-marschall.de                                               //
// Web:    www.daniel-marschall.de & www.viathinksoft.de                          //
////////////////////////////////////////////////////////////////////////////////////
// Revision: 04 JUN 2023                                                          //
// 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)                                        //

 
uses
  Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;
 
const
  RECBINUNIT_VERSION = '2023-06-04';
 
  RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';
  NULL_GUID:      TGUID = '{00000000-0000-0000-0000-000000000000}';
 
type

    finally
      FreeAndNil(fs);
    end;
  end;
 
  // TODO: Nice would be some progress callback function
  procedure _HandleVistaDir(ADirectory: string);
  var
    SR: TSearchRec;
    fs: TFileStream;
    id: string;
  begin
    ADirectory := IncludeTrailingPathDelimiter(ADirectory);
 
    //if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
    if FindFirst(ADirectory + '*', faAnyFile, SR) = 0 then
    begin
      repeat
        // FindFirst filter '$I*' finds the file '$RJK3R4P.~43~' and '$RJB99A3.~55~' (yes, $R !!!) Why?!
        // ... so, we just filter for '*' and try to find the '$I*' files ourselves...
        if UpperCase(Copy(sr.Name,1,2)) = '$I' then
        begin
          id := sr.Name;
          { id := ChangeFileExt(id, ''); }  // Removed code: We keep the file extention as part of the ID, because we do not know if the ID is otherwise unique
          id := Copy(id, 3, Length(id)-2);
 
          fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);

            fs.Seek(0, soFromBeginning);
            list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id));
          finally
            FreeAndNil(fs);
          end;
        end;
      until FindNext(SR) <> 0;
    end;
    FindClose(SR);
  end;
 

procedure TRbVistaItem.ReadFromStream(stream: TStream);
var
  r1: TRbVistaRecord1;
  r2: TRbVistaRecord2Head;
  r2SourceUnicode: array of WideChar;
  ver: int64;
  i: Integer;
resourcestring
  LNG_VISTA_WRONG_FORMAT = 'Invalid Vista index format version %d at file %s';
begin
  stream.ReadBuffer(ver, SizeOf(ver));
 
  if ver = 1 then
  begin
    stream.Seek(0, soBeginning);
    stream.ReadBuffer(r1, SizeOf(r1));
 
    (* FSourceAnsi := AnsiString(WideCharArrayToWideString(r1.sourceUnicode)); *)

    FID := ''; // will be added manually (at the constructor)
    FSourceDrive := Char(r1.sourceUnicode[1]);
    FDeletionTime := FileTimeToDateTime(r1.deletionTime);
    FOriginalSize := r1.originalSize;
  end
  else if ver = 2 then
  begin
    stream.Seek(0, soBeginning);
    stream.ReadBuffer(r2, SizeOf(r2));
 
    SetLength(r2SourceUnicode, SizeOf(WideChar)*(r2.SourceCountChars-1));

    FDeletionTime := FileTimeToDateTime(r2.deletionTime);
    FOriginalSize := r2.originalSize;
  end
  else
  begin
    raise Exception.CreateFmt(LNG_VISTA_WRONG_FORMAT, [ver, FID]);
  end;
 
  // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
  // TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
  AnsiRemoveNulChars(FSourceAnsi);

end;
 
constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string);
begin
  inherited Create;
 
  FIndexFile := AIndexFile;
  FID := AID;
  ReadFromStream(fs);
end;
 
{ TRecycleBinManager }
 
class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean;

Rev 102	Rev 106
Line 3...	Line 3...
3	////////////////////////////////////////////////////////////////////////////////////	3	////////////////////////////////////////////////////////////////////////////////////
4	// RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT //	4	// RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT //
5	// E-MAIL: info@daniel-marschall.de //	5	// E-MAIL: info@daniel-marschall.de //
6	// Web: www.daniel-marschall.de & www.viathinksoft.de //	6	// Web: www.daniel-marschall.de & www.viathinksoft.de //
7	////////////////////////////////////////////////////////////////////////////////////	7	////////////////////////////////////////////////////////////////////////////////////
8	// Revision: 07 JUL 2022 //	8	// Revision: 04 JUN 2023 //
9	// This unit is freeware, but please link to my website if you are using it! //	9	// This unit is freeware, but please link to my website if you are using it! //
10	////////////////////////////////////////////////////////////////////////////////////	10	////////////////////////////////////////////////////////////////////////////////////
11	// Successfully tested with: //	11	// Successfully tested with: //
12	// Windows 95b (without IE4 Shell Extensions) //	12	// Windows 95b (without IE4 Shell Extensions) //
13	// Windows 95b (with IE4 Shell Extensions) //	13	// Windows 95b (with IE4 Shell Extensions) //
Line 53...	Line 53...
53		53
54	uses	54	uses
55	Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;	55	Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;
56		56
57	const	57	const
58	RECBINUNIT_VERSION = '2022-07-07';	58	RECBINUNIT_VERSION = '2023-06-04';
59		59
60	RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';	60	RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';
61	NULL_GUID: TGUID = '{00000000-0000-0000-0000-000000000000}';	61	NULL_GUID: TGUID = '{00000000-0000-0000-0000-000000000000}';
62		62
63	type	63	type
Line 928...	Line 928...
928	finally	928	finally
929	FreeAndNil(fs);	929	FreeAndNil(fs);
930	end;	930	end;
931	end;	931	end;
932		932
-		933	// TODO: Nice would be some progress callback function
933	procedure _HandleVistaDir(ADirectory: string);	934	procedure _HandleVistaDir(ADirectory: string);
934	var	935	var
935	SR: TSearchRec;	936	SR: TSearchRec;
936	fs: TFileStream;	937	fs: TFileStream;
937	id: string;	938	id: string;
938	begin	939	begin
939	ADirectory := IncludeTrailingPathDelimiter(ADirectory);	940	ADirectory := IncludeTrailingPathDelimiter(ADirectory);
940		941
941	if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then	942	//if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then
-		943	if FindFirst(ADirectory + '*', faAnyFile, SR) = 0 then
942	begin	944	begin
943	repeat	945	repeat
-		946	// FindFirst filter '$I*' finds the file '$RJK3R4P.~43~' and '$RJB99A3.~55~' (yes, $R !!!) Why?!
-		947	// ... so, we just filter for '' and try to find the '$I' files ourselves...
-		948	if UpperCase(Copy(sr.Name,1,2)) = '$I' then
-		949	begin
944	id := sr.Name;	950	id := sr.Name;
945	{ id := ChangeFileExt(id, ''); } // Removed code: We keep the file extention as part of the ID, because we do not know if the ID is otherwise unique	951	{ id := ChangeFileExt(id, ''); } // Removed code: We keep the file extention as part of the ID, because we do not know if the ID is otherwise unique
946	id := Copy(id, 3, Length(id)-2);	952	id := Copy(id, 3, Length(id)-2);
947		953
948	fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);	954	fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead);
Line 950...	Line 956...
950	fs.Seek(0, soFromBeginning);	956	fs.Seek(0, soFromBeginning);
951	list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id));	957	list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id));
952	finally	958	finally
953	FreeAndNil(fs);	959	FreeAndNil(fs);
954	end;	960	end;
-		961	end;
955	until FindNext(SR) <> 0;	962	until FindNext(SR) <> 0;
956	end;	963	end;
957	FindClose(SR);	964	FindClose(SR);
958	end;	965	end;
959		966
Line 1579...	Line 1586...
1579	procedure TRbVistaItem.ReadFromStream(stream: TStream);	1586	procedure TRbVistaItem.ReadFromStream(stream: TStream);
1580	var	1587	var
1581	r1: TRbVistaRecord1;	1588	r1: TRbVistaRecord1;
1582	r2: TRbVistaRecord2Head;	1589	r2: TRbVistaRecord2Head;
1583	r2SourceUnicode: array of WideChar;	1590	r2SourceUnicode: array of WideChar;
1584	version: int64;	1591	ver: int64;
1585	i: Integer;	1592	i: Integer;
1586	resourcestring	1593	resourcestring
1587	LNG_VISTA_WRONG_FORMAT = 'Invalid Vista index format version %d';	1594	LNG_VISTA_WRONG_FORMAT = 'Invalid Vista index format version %d at file %s';
1588	begin	1595	begin
1589	stream.ReadBuffer(version, SizeOf(version));	1596	stream.ReadBuffer(ver, SizeOf(ver));
1590		1597
1591	if version = 1 then	1598	if ver = 1 then
1592	begin	1599	begin
1593	stream.Seek(0, soBeginning);	1600	stream.Seek(0, soBeginning);
1594	stream.ReadBuffer(r1, SizeOf(r1));	1601	stream.ReadBuffer(r1, SizeOf(r1));
1595		1602
1596	(* FSourceAnsi := AnsiString(WideCharArrayToWideString(r1.sourceUnicode)); *)	1603	(* FSourceAnsi := AnsiString(WideCharArrayToWideString(r1.sourceUnicode)); *)
Line 1606...	Line 1613...
1606	FID := ''; // will be added manually (at the constructor)	1613	FID := ''; // will be added manually (at the constructor)
1607	FSourceDrive := Char(r1.sourceUnicode[1]);	1614	FSourceDrive := Char(r1.sourceUnicode[1]);
1608	FDeletionTime := FileTimeToDateTime(r1.deletionTime);	1615	FDeletionTime := FileTimeToDateTime(r1.deletionTime);
1609	FOriginalSize := r1.originalSize;	1616	FOriginalSize := r1.originalSize;
1610	end	1617	end
1611	else if version = 2 then	1618	else if ver = 2 then
1612	begin	1619	begin
1613	stream.Seek(0, soBeginning);	1620	stream.Seek(0, soBeginning);
1614	stream.ReadBuffer(r2, SizeOf(r2));	1621	stream.ReadBuffer(r2, SizeOf(r2));
1615		1622
1616	SetLength(r2SourceUnicode, SizeOf(WideChar)*(r2.SourceCountChars-1));	1623	SetLength(r2SourceUnicode, SizeOf(WideChar)*(r2.SourceCountChars-1));
Line 1632...	Line 1639...
1632	FDeletionTime := FileTimeToDateTime(r2.deletionTime);	1639	FDeletionTime := FileTimeToDateTime(r2.deletionTime);
1633	FOriginalSize := r2.originalSize;	1640	FOriginalSize := r2.originalSize;
1634	end	1641	end
1635	else	1642	else
1636	begin	1643	begin
1637	raise Exception.CreateFmt(LNG_VISTA_WRONG_FORMAT, [version]);	1644	raise Exception.CreateFmt(LNG_VISTA_WRONG_FORMAT, [ver, FID]);
1638	end;	1645	end;
1639		1646
1640	// Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)	1647	// Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
1641	// TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!	1648	// TODO: Instead of using this workaround, fix "SourceUnicode" and "SourceAnsi" in the first place!
1642	AnsiRemoveNulChars(FSourceAnsi);	1649	AnsiRemoveNulChars(FSourceAnsi);
Line 1666...	Line 1673...
1666	end;	1673	end;
1667		1674
1668	constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string);	1675	constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string);
1669	begin	1676	begin
1670	inherited Create;	1677	inherited Create;
1671	ReadFromStream(fs);	-
1672	FIndexFile := AIndexFile;	1678	FIndexFile := AIndexFile;
1673	FID := AID;	1679	FID := AID;
-		1680	ReadFromStream(fs);
1674	end;	1681	end;
1675		1682
1676	{ TRecycleBinManager }	1683	{ TRecycleBinManager }
1677		1684
1678	class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean;	1685	class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean;

Subversion Repositories recyclebinunit

recyclebinunit/trunk/Recycle Bin Unit v2/RecBinUnit2.pas @ 90 – Rev 102 → 106