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



  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 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;

  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;
 

  C_SHGetSettings = 'SHGetSettings';
  C_SHGetSetSettings = 'SHGetSetSettings';
 
type
  TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
  TGetVolumeNameForVolumeMountPointA = function(lpszVolumeMountPoint: LPCSTR; lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall;
  TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: PChar; dwFlags: DWORD): HRESULT; stdcall;
  TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD); stdcall;
  TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL); stdcall;
 
procedure AnsiRemoveNulChars(var s: AnsiString);

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 AnsiChar;
  x: string;
  PGetVolumeNameForVolumeMountPointA: TGetVolumeNameForVolumeMountPointA;
  RBHandle: THandle;
begin
  RBHandle := LoadLibrary(kernel32);
  try
    if RBHandle <> 0 then
    begin
      PGetVolumeNameForVolumeMountPointA := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);
      if not Assigned(@PGetVolumeNameForVolumeMountPointA) then
      begin
        result := GetLastError;
        FreeLibrary(RBHandle);
        RBHandle := 0;
      end
      else
      begin
        if PGetVolumeNameForVolumeMountPointA(PAnsiChar(AnsiString(driveLetter+':\')), Buffer, SizeOf(Buffer)) then
        begin
          x := string(buffer);
          x := copy(x, 11, 38);
          guid := StringToGUID(x);
          result := ERROR_SUCCESS;
        end
        else

    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

begin
  // Does the drive exist?
  // see http://www.delphipraxis.net/post2933.html
  if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then
  begin
    raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(string(FDriveLetter))+':']);
  end;
end;
 
constructor TRbDrive.Create(ADriveLetter: AnsiChar);
begin
  inherited Create;
 
  FDriveLetter := ADriveLetter;
  CheckDriveExisting;

 
    // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
    // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
    begin
      if reg.OpenKeyReadOnly(string(FDriveLetter)) then
      begin
        if reg.ValueExists('Percent') then
        begin
          // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 

 
        // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
        // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
        if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
        begin
          if reg.OpenKeyReadOnly(string(FDriveLetter)) then
          begin
            if reg.ValueExists('NukeOnDelete') then
            begin
              // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
 

  // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
  // Zwecken eingesetzt werden soll.
  if r.sourceAnsi[0] = #0 then
  begin
    FRemovedEntry := true;
    r.sourceAnsi[0] := AnsiChar(FSourceDrive);
  end;
 
  FSourceAnsi := r.sourceAnsi;
  FSourceUnicode := WideString(r.sourceAnsi); // Unicode does not exist in INFO(1) structure
  FID := IntToStr(r.recordNumber);
  FDeletionTime := FileTimeToDateTime(r.deletionTime);
  FOriginalSize := r.originalSize;
 
  // Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)

    Exit;
  end;
 
  // e.g. C:\...\DC0.doc
  result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
            'D' + (* SourceDrive *) Source[1] + ID + ExtractFileExt(Source);
end;
 
constructor TRbInfoAItem.Create(fs: TStream; AIndexFile: string);
begin
  inherited Create;

    stream.Seek(0, soBeginning);
    stream.ReadBuffer(r1, SizeOf(r1));
    FSourceAnsi := AnsiString(r1.sourceUnicode); // Invalid chars are automatically converted into '?'
    FSourceUnicode := WideString(r1.sourceUnicode);
    FID := ''; // will be added manually (at the constructor)
    FSourceDrive := r1.sourceUnicode[1];
    FDeletionTime := FileTimeToDateTime(r1.deletionTime);
    FOriginalSize := r1.originalSize;
  end
  else if version = 2 then
  begin

    stream.Read(r2SourceUnicode[0], 2*(r2.sourceCountChars-1));
 
    FSourceAnsi := AnsiString(WideString(r2sourceUnicode)); // Invalid chars are automatically converted into '?'
    FSourceUnicode := WideString(r2sourceUnicode);
    FID := ''; // will be added manually (at the constructor)
    FSourceDrive := r2sourceUnicode[1];
    FDeletionTime := FileTimeToDateTime(r2.deletionTime);
    FOriginalSize := r2.originalSize;
  end
  else
  begin

  end;
end;
 
class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive});
var
  drive: AnsiChar;
begin
  for drive := 'A' to 'Z' do
    if RecycleBinPossible(drive) then
      list.Add(TRbDrive.Create(drive));
end;

  finally
    drives.Free;
  end;
end;
 
class function TRecycleBinManager.RecycleBinPossible(Drive: AnsiChar): boolean;
var
  typ: Integer;
begin
  // Does the drive exist?
  // see http://www.delphipraxis.net/post2933.html

  RBHandle: THandle;
 
  reg: TRegistry;
  rbuf: array[0..255] of byte;
 
  //dwResult: DWORD;
  lpdwResult: PDWORD_PTR;
begin
  PSHGetSetSettings := nil;
  lpdwResult := nil;
 
  RBHandle := LoadLibrary(shell32);
  try
    if RBHandle <> 0 then
    begin

      PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
 
      SendMessageTimeout (
        HWND_BROADCAST, WM_SETTINGCHANGE,
        0, lParam (pChar ('ShellState')),
        SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
      );
    end
    else
    begin
      reg := TRegistry.Create;

          reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
 
          SendMessageTimeout (
            HWND_BROADCAST, WM_SETTINGCHANGE,
            0, lParam (pChar ('ShellState')),
            SMTO_ABORTIFHUNG, 5000, lpdwResult(*dwResult*)
          );
 
          reg.CloseKey;
        end
        else

Rev 88	Rev 89
Line 159...	Line 159...
159	end;	159	end;
160		160
161	// TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind?	161	// TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind?
162	TRbDrive = class(TObject)	162	TRbDrive = class(TObject)
163	strict private	163	strict private
164	FDriveLetter: Char;	164	FDriveLetter: AnsiChar;
165		165
166	function OldCapacityPercent(var res: integer): boolean; // in % (0-100)	166	function OldCapacityPercent(var res: integer): boolean; // in % (0-100)
167	function NewCapacityAbsolute(var res: integer): boolean; // in MB	167	function NewCapacityAbsolute(var res: integer): boolean; // in MB
168		168
169	function DiskSize: integer; // in MB	169	function DiskSize: integer; // in MB
Line 176...	Line 176...
176	function GetVolumeGUID: TGUID;	176	function GetVolumeGUID: TGUID;
177	function GetVolumeGUIDAvailable: boolean;	177	function GetVolumeGUIDAvailable: boolean;
178		178
179	// TODO: get drive serial	179	// TODO: get drive serial
180	public	180	public
181	constructor Create(ADriveLetter: Char);	181	constructor Create(ADriveLetter: AnsiChar);
182		182
183	// Wenn UserSID='', dann werden alle Recycler gefunden	183	// Wenn UserSID='', dann werden alle Recycler gefunden
184	procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');	184	procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');
185		185
186	property DriveLetter: Char read FDriveLetter;	186	property DriveLetter: AnsiChar read FDriveLetter;
187	property VolumeGUID: TGUID read GetVolumeGUID;	187	property VolumeGUID: TGUID read GetVolumeGUID;
188	property VolumeGUIDAvailable: boolean read GetVolumeGUIDAvailable;	188	property VolumeGUIDAvailable: boolean read GetVolumeGUIDAvailable;
189	function GetAPIInfo: TSHQueryRBInfo;	189	function GetAPIInfo: TSHQueryRBInfo;
190	function GetSize: int64;	190	function GetSize: int64;
191	function GetNumItems: int64;	191	function GetNumItems: int64;
Line 199...	Line 199...
199	GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);	199	GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
200		200
201	TRecycleBinManager = class(TObject)	201	TRecycleBinManager = class(TObject)
202	public	202	public
203	class procedure ListDrives(list: TObjectList{TRbDrive}); static;	203	class procedure ListDrives(list: TObjectList{TRbDrive}); static;
204	class function RecycleBinPossible(Drive: Char): boolean; static;	204	class function RecycleBinPossible(Drive: AnsiChar): boolean; static;
205		205
206	class function OwnRecyclersSize: int64; static;	206	class function OwnRecyclersSize: int64; static;
207	class function OwnRecyclersNumItems: int64; static;	207	class function OwnRecyclersNumItems: int64; static;
208	class function OwnRecyclersEmpty: boolean; static;	208	class function OwnRecyclersEmpty: boolean; static;
209		209
Line 362...	Line 362...
362	C_SHGetSettings = 'SHGetSettings';	362	C_SHGetSettings = 'SHGetSettings';
363	C_SHGetSetSettings = 'SHGetSetSettings';	363	C_SHGetSetSettings = 'SHGetSetSettings';
364		364
365	type	365	type
366	TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;	366	TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
367	TGetVolumeNameForVolumeMountPoint = function(lpszVolumeMountPoint: LPCTSTR; lpszVolumeName: LPTSTR; cchBufferLength: DWORD): BOOL; stdcall;	367	TGetVolumeNameForVolumeMountPointA = function(lpszVolumeMountPoint: LPCSTR; lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall;
368	TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: PChar; dwFlags: DWORD): HRESULT; stdcall;	368	TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: PChar; dwFlags: DWORD): HRESULT; stdcall;
369	TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD); stdcall;	369	TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD); stdcall;
370	TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL); stdcall;	370	TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL); stdcall;
371		371
372	procedure AnsiRemoveNulChars(var s: AnsiString);	372	procedure AnsiRemoveNulChars(var s: AnsiString);
Line 379...	Line 379...
379	begin	379	begin
380	while (Length(s) > 0) and (s[Length(s)] = #0) do	380	while (Length(s) > 0) and (s[Length(s)] = #0) do
381	s := Copy(s, 1, Length(s)-1);	381	s := Copy(s, 1, Length(s)-1);
382	end;	382	end;
383		383
384	function GetDriveGUID(driveLetter: Char; var guid: TGUID): DWORD;	384	function GetDriveGUID(driveLetter: AnsiChar; var guid: TGUID): DWORD;
385	var	385	var
386	Buffer: array[0..50] of AnsiChar;	386	Buffer: array[0..50] of AnsiChar;
387	x: string;	387	x: string;
388	PGetVolumeNameForVolumeMountPoint: TGetVolumeNameForVolumeMountPoint;	388	PGetVolumeNameForVolumeMountPointA: TGetVolumeNameForVolumeMountPointA;
389	RBHandle: THandle;	389	RBHandle: THandle;
390	begin	390	begin
391	RBHandle := LoadLibrary(kernel32);	391	RBHandle := LoadLibrary(kernel32);
392	try	392	try
393	if RBHandle <> 0 then	393	if RBHandle <> 0 then
394	begin	394	begin
395	PGetVolumeNameForVolumeMountPoint := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);	395	PGetVolumeNameForVolumeMountPointA := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint);
396	if not Assigned(@PGetVolumeNameForVolumeMountPoint) then	396	if not Assigned(@PGetVolumeNameForVolumeMountPointA) then
397	begin	397	begin
398	result := GetLastError;	398	result := GetLastError;
399	FreeLibrary(RBHandle);	399	FreeLibrary(RBHandle);
400	RBHandle := 0;	400	RBHandle := 0;
401	end	401	end
402	else	402	else
403	begin	403	begin
404	if PGetVolumeNameForVolumeMountPoint(PAnsiChar(driveLetter+':\'), Buffer, SizeOf(Buffer)) then	404	if PGetVolumeNameForVolumeMountPointA(PAnsiChar(AnsiString(driveLetter+':\')), Buffer, SizeOf(Buffer)) then
405	begin	405	begin
406	x := buffer;	406	x := string(buffer);
407	x := copy(x, 11, 38);	407	x := copy(x, 11, 38);
408	guid := StringToGUID(x);	408	guid := StringToGUID(x);
409	result := ERROR_SUCCESS;	409	result := ERROR_SUCCESS;
410	end	410	end
411	else	411	else
Line 478...	Line 478...
478	end;	478	end;
479	if not RemoveDir(Name) then result := false;	479	if not RemoveDir(Name) then result := false;
480	end;	480	end;
481	end;	481	end;
482		482
483	function DriveLetterToDriveNumber(driveLetter: Char): integer;	483	function DriveLetterToDriveNumber(driveLetter: AnsiChar): integer;
484	var	484	var
485	tmp: string;	485	tmp: string;
486	begin	486	begin
487	tmp := LowerCase(driveLetter);	487	tmp := LowerCase(string(driveLetter));
488	result := Ord(tmp[1])-Ord('a');	488	result := Ord(tmp[1])-Ord('a');
489	end;	489	end;
490		490
491	function GetStringFromDLL(filename: string; num: integer): string;	491	function GetStringFromDLL(filename: string; num: integer): string;
492	const	492	const
Line 946...	Line 946...
946	begin	946	begin
947	// Does the drive exist?	947	// Does the drive exist?
948	// see http://www.delphipraxis.net/post2933.html	948	// see http://www.delphipraxis.net/post2933.html
949	if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then	949	if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then
950	begin	950	begin
951	raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(FDriveLetter)+':']);	951	raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(string(FDriveLetter))+':']);
952	end;	952	end;
953	end;	953	end;
954		954
955	constructor TRbDrive.Create(ADriveLetter: Char);	955	constructor TRbDrive.Create(ADriveLetter: AnsiChar);
956	begin	956	begin
957	inherited Create;	957	inherited Create;
958		958
959	FDriveLetter := ADriveLetter;	959	FDriveLetter := ADriveLetter;
960	CheckDriveExisting;	960	CheckDriveExisting;
Line 1093...	Line 1093...
1093		1093
1094	// Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.	1094	// Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
1095	// Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.	1095	// Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
1096	if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then	1096	if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
1097	begin	1097	begin
1098	if reg.OpenKeyReadOnly(FDriveLetter) then	1098	if reg.OpenKeyReadOnly(string(FDriveLetter)) then
1099	begin	1099	begin
1100	if reg.ValueExists('Percent') then	1100	if reg.ValueExists('Percent') then
1101	begin	1101	begin
1102	// Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry	1102	// Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
1103		1103
Line 1191...	Line 1191...
1191		1191
1192	// Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.	1192	// Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
1193	// Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.	1193	// Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
1194	if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then	1194	if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
1195	begin	1195	begin
1196	if reg.OpenKeyReadOnly(FDriveLetter) then	1196	if reg.OpenKeyReadOnly(string(FDriveLetter)) then
1197	begin	1197	begin
1198	if reg.ValueExists('NukeOnDelete') then	1198	if reg.ValueExists('NukeOnDelete') then
1199	begin	1199	begin
1200	// Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry	1200	// Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
1201		1201
Line 1374...	Line 1374...
1374	// Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen	1374	// Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen
1375	// Zwecken eingesetzt werden soll.	1375	// Zwecken eingesetzt werden soll.
1376	if r.sourceAnsi[0] = #0 then	1376	if r.sourceAnsi[0] = #0 then
1377	begin	1377	begin
1378	FRemovedEntry := true;	1378	FRemovedEntry := true;
1379	r.sourceAnsi[0] := FSourceDrive;	1379	r.sourceAnsi[0] := AnsiChar(FSourceDrive);
1380	end;	1380	end;
1381		1381
1382	FSourceAnsi := r.sourceAnsi;	1382	FSourceAnsi := r.sourceAnsi;
1383	FSourceUnicode := r.sourceAnsi; // Unicode does not exist in INFO(1) structure	1383	FSourceUnicode := WideString(r.sourceAnsi); // Unicode does not exist in INFO(1) structure
1384	FID := IntToStr(r.recordNumber);	1384	FID := IntToStr(r.recordNumber);
1385	FDeletionTime := FileTimeToDateTime(r.deletionTime);	1385	FDeletionTime := FileTimeToDateTime(r.deletionTime);
1386	FOriginalSize := r.originalSize;	1386	FOriginalSize := r.originalSize;
1387		1387
1388	// Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)	1388	// Remove #0 at the end. There are some bugs where #0 is added to ANSI/Unicode read paths?! (probably in the ReadVista stuff)
Line 1412...	Line 1412...
1412	Exit;	1412	Exit;
1413	end;	1413	end;
1414		1414
1415	// e.g. C:\...\DC0.doc	1415	// e.g. C:\...\DC0.doc
1416	result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +	1416	result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) +
1417	'D' + (* SourceDrive *) SourceAnsi[1] + ID + ExtractFileExt(SourceAnsi);	1417	'D' + (* SourceDrive *) Source[1] + ID + ExtractFileExt(Source);
1418	end;	1418	end;
1419		1419
1420	constructor TRbInfoAItem.Create(fs: TStream; AIndexFile: string);	1420	constructor TRbInfoAItem.Create(fs: TStream; AIndexFile: string);
1421	begin	1421	begin
1422	inherited Create;	1422	inherited Create;
Line 1527...	Line 1527...
1527	stream.Seek(0, soBeginning);	1527	stream.Seek(0, soBeginning);
1528	stream.ReadBuffer(r1, SizeOf(r1));	1528	stream.ReadBuffer(r1, SizeOf(r1));
1529	FSourceAnsi := AnsiString(r1.sourceUnicode); // Invalid chars are automatically converted into '?'	1529	FSourceAnsi := AnsiString(r1.sourceUnicode); // Invalid chars are automatically converted into '?'
1530	FSourceUnicode := WideString(r1.sourceUnicode);	1530	FSourceUnicode := WideString(r1.sourceUnicode);
1531	FID := ''; // will be added manually (at the constructor)	1531	FID := ''; // will be added manually (at the constructor)
1532	FSourceDrive := AnsiChar(r1.sourceUnicode[1]);	1532	FSourceDrive := r1.sourceUnicode[1];
1533	FDeletionTime := FileTimeToDateTime(r1.deletionTime);	1533	FDeletionTime := FileTimeToDateTime(r1.deletionTime);
1534	FOriginalSize := r1.originalSize;	1534	FOriginalSize := r1.originalSize;
1535	end	1535	end
1536	else if version = 2 then	1536	else if version = 2 then
1537	begin	1537	begin
Line 1542...	Line 1542...
1542	stream.Read(r2SourceUnicode[0], 2*(r2.sourceCountChars-1));	1542	stream.Read(r2SourceUnicode[0], 2*(r2.sourceCountChars-1));
1543		1543
1544	FSourceAnsi := AnsiString(WideString(r2sourceUnicode)); // Invalid chars are automatically converted into '?'	1544	FSourceAnsi := AnsiString(WideString(r2sourceUnicode)); // Invalid chars are automatically converted into '?'
1545	FSourceUnicode := WideString(r2sourceUnicode);	1545	FSourceUnicode := WideString(r2sourceUnicode);
1546	FID := ''; // will be added manually (at the constructor)	1546	FID := ''; // will be added manually (at the constructor)
1547	FSourceDrive := AnsiChar(r2sourceUnicode[1]);	1547	FSourceDrive := r2sourceUnicode[1];
1548	FDeletionTime := FileTimeToDateTime(r2.deletionTime);	1548	FDeletionTime := FileTimeToDateTime(r2.deletionTime);
1549	FOriginalSize := r2.originalSize;	1549	FOriginalSize := r2.originalSize;
1550	end	1550	end
1551	else	1551	else
1552	begin	1552	begin
Line 1779...	Line 1779...
1779	end;	1779	end;
1780	end;	1780	end;
1781		1781
1782	class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive});	1782	class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive});
1783	var	1783	var
1784	drive: Char;	1784	drive: AnsiChar;
1785	begin	1785	begin
1786	for drive := 'A' to 'Z' do	1786	for drive := 'A' to 'Z' do
1787	if RecycleBinPossible(drive) then	1787	if RecycleBinPossible(drive) then
1788	list.Add(TRbDrive.Create(drive));	1788	list.Add(TRbDrive.Create(drive));
1789	end;	1789	end;
Line 1844...	Line 1844...
1844	finally	1844	finally
1845	drives.Free;	1845	drives.Free;
1846	end;	1846	end;
1847	end;	1847	end;
1848		1848
1849	class function TRecycleBinManager.RecycleBinPossible(Drive: Char): boolean;	1849	class function TRecycleBinManager.RecycleBinPossible(Drive: AnsiChar): boolean;
1850	var	1850	var
1851	typ: Integer;	1851	typ: Integer;
1852	begin	1852	begin
1853	// Does the drive exist?	1853	// Does the drive exist?
1854	// see http://www.delphipraxis.net/post2933.html	1854	// see http://www.delphipraxis.net/post2933.html
Line 2325...	Line 2325...
2325	RBHandle: THandle;	2325	RBHandle: THandle;
2326		2326
2327	reg: TRegistry;	2327	reg: TRegistry;
2328	rbuf: array[0..255] of byte;	2328	rbuf: array[0..255] of byte;
2329		2329
2330	dwResult: DWORD;	2330	//dwResult: DWORD;
-		2331	lpdwResult: PDWORD_PTR;
2331	begin	2332	begin
2332	PSHGetSetSettings := nil;	2333	PSHGetSetSettings := nil;
-		2334	lpdwResult := nil;
2333		2335
2334	RBHandle := LoadLibrary(shell32);	2336	RBHandle := LoadLibrary(shell32);
2335	try	2337	try
2336	if RBHandle <> 0 then	2338	if RBHandle <> 0 then
2337	begin	2339	begin
Line 2358...	Line 2360...
2358	PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set	2360	PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
2359		2361
2360	SendMessageTimeout (	2362	SendMessageTimeout (
2361	HWND_BROADCAST, WM_SETTINGCHANGE,	2363	HWND_BROADCAST, WM_SETTINGCHANGE,
2362	0, lParam (pChar ('ShellState')),	2364	0, lParam (pChar ('ShellState')),
2363	SMTO_ABORTIFHUNG, 5000, dwResult	2365	SMTO_ABORTIFHUNG, 5000, lpdwResult(dwResult)
2364	);	2366	);
2365	end	2367	end
2366	else	2368	else
2367	begin	2369	begin
2368	reg := TRegistry.Create;	2370	reg := TRegistry.Create;
Line 2388...	Line 2390...
2388	reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set	2390	reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
2389		2391
2390	SendMessageTimeout (	2392	SendMessageTimeout (
2391	HWND_BROADCAST, WM_SETTINGCHANGE,	2393	HWND_BROADCAST, WM_SETTINGCHANGE,
2392	0, lParam (pChar ('ShellState')),	2394	0, lParam (pChar ('ShellState')),
2393	SMTO_ABORTIFHUNG, 5000, dwResult	2395	SMTO_ABORTIFHUNG, 5000, lpdwResult(dwResult)
2394	);	2396	);
2395		2397
2396	reg.CloseKey;	2398	reg.CloseKey;
2397	end	2399	end
2398	else	2400	else

Subversion Repositories recyclebinunit

recyclebinunit/trunk/Recycle Bin Unit v2/RecBinUnit2.pas – Rev 88 → 89