WebSVN – recyclebinunit – Diff – /trunk/Recycle Bin Unit/RecyclerFunctions.pas



// Windows XP-SP3                                                                 //
// Windows 2000-SP4                                                               //
// Windows 2003 Server EE SP1                                                     //
// Windows Vista                                                                  //
// Windows 7                                                                      //
////////////////////////////////////////////////////////////////////////////////////
// DOES **NOT** WORK WITH "VERSION 2" INDEX FILES USED IN LATER VERSIONS OF WIN10 //
// USE RECYCLE BIN UNIT V2 INSTEAD!                                               //
////////////////////////////////////////////////////////////////////////////////////
//                                                                                //
//  Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //
//  RecyclerGetDateTime() functions, because the unit "DateUtils" is missing.     //
//  Warning! This is a platform unit.                                             //

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

    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

end;
 
function RecyclerGlobalIsNukeOnDelete: boolean;
var
  reg: TRegistry;
  dump: AnsiString;
const
  RES_DEFAULT = false;
begin
  result := false;
 

      begin
        // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
        // See comment at RecyclerSpecificIsNukeOnDelete()
 
        dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
        result := GetAnsiCharBit(dump[68], 3);
      end
      else
      begin
        // Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo

end;
 
function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
var
  reg: TRegistry;
  dump: AnsiString;
  d: Byte;
const
  RES_DEFAULT = false;
begin
  result := false;

      begin
        if reg.ValueExists('PurgeInfo') then
        begin
          // Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
 
          dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
 
          // NOT tested, only theoretical! My idea about the possible structure is:
          //
          // Byte      0x40       0x41       0x42       0x43
          // Bit       76543210   76543210   76543210   76543210

    end
    else
    begin
      // Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)
      // if Path is a floppy or CD drive...
      // Windows 10: Error 0x8007003 for Path 'C:\'
      raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);
    end;
  end
  else
    raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);

Rev 80	Rev 91
Line 20...	Line 20...
20	// Windows XP-SP3 //	20	// Windows XP-SP3 //
21	// Windows 2000-SP4 //	21	// Windows 2000-SP4 //
22	// Windows 2003 Server EE SP1 //	22	// Windows 2003 Server EE SP1 //
23	// Windows Vista //	23	// Windows Vista //
24	// Windows 7 //	24	// Windows 7 //
-		25	////////////////////////////////////////////////////////////////////////////////////
-		26	// DOES NOT WORK WITH "VERSION 2" INDEX FILES USED IN LATER VERSIONS OF WIN10 //
25	// Windows 10 //	27	// USE RECYCLE BIN UNIT V2 INSTEAD! //
26	////////////////////////////////////////////////////////////////////////////////////	28	////////////////////////////////////////////////////////////////////////////////////
27	// //	29	// //
28	// Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //	30	// Needs Delphi 4 or higher. If you are using Delphi 4 or 5, you can not use the //
29	// RecyclerGetDateTime() functions, because the unit "DateUtils" is missing. //	31	// RecyclerGetDateTime() functions, because the unit "DateUtils" is missing. //
30	// Warning! This is a platform unit. //	32	// Warning! This is a platform unit. //
Line 2281...	Line 2283...
2281	RBHandle: THandle;	2283	RBHandle: THandle;
2282		2284
2283	reg: TRegistry;	2285	reg: TRegistry;
2284	rbuf: array[0..255] of byte;	2286	rbuf: array[0..255] of byte;
2285		2287
2286	dwResult: DWORD;	2288	//dwResult: DWORD;
-		2289	lpdwResult: PDWORD_PTR;
2287	begin	2290	begin
2288	PSHGetSetSettings := nil;	2291	PSHGetSetSettings := nil;
-		2292	lpdwResult := nil;
2289		2293
2290	RBHandle := LoadLibrary(shell32);	2294	RBHandle := LoadLibrary(shell32);
2291	if(RBHandle <> 0) then	2295	if(RBHandle <> 0) then
2292	begin	2296	begin
2293	PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);	2297	PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings);
Line 2306...	Line 2310...
2306	PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set	2310	PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set
2307		2311
2308	SendMessageTimeout (	2312	SendMessageTimeout (
2309	HWND_BROADCAST, WM_SETTINGCHANGE,	2313	HWND_BROADCAST, WM_SETTINGCHANGE,
2310	0, lParam (pChar ('ShellState')),	2314	0, lParam (pChar ('ShellState')),
2311	SMTO_ABORTIFHUNG, 5000, dwResult	2315	SMTO_ABORTIFHUNG, 5000, lpdwResult(dwResult)
2312	);	2316	);
2313	end	2317	end
2314	else	2318	else
2315	begin	2319	begin
2316	reg := TRegistry.Create;	2320	reg := TRegistry.Create;
Line 2329...	Line 2333...
2329	reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set	2333	reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set
2330		2334
2331	SendMessageTimeout (	2335	SendMessageTimeout (
2332	HWND_BROADCAST, WM_SETTINGCHANGE,	2336	HWND_BROADCAST, WM_SETTINGCHANGE,
2333	0, lParam (pChar ('ShellState')),	2337	0, lParam (pChar ('ShellState')),
2334	SMTO_ABORTIFHUNG, 5000, dwResult	2338	SMTO_ABORTIFHUNG, 5000, lpdwResult(dwResult)
2335	);	2339	);
2336		2340
2337	reg.CloseKey;	2341	reg.CloseKey;
2338	end	2342	end
2339	else	2343	else
Line 2676...	Line 2680...
2676	end;	2680	end;
2677		2681
2678	function RecyclerGlobalIsNukeOnDelete: boolean;	2682	function RecyclerGlobalIsNukeOnDelete: boolean;
2679	var	2683	var
2680	reg: TRegistry;	2684	reg: TRegistry;
2681	dump: string;	2685	dump: AnsiString;
2682	const	2686	const
2683	RES_DEFAULT = false;	2687	RES_DEFAULT = false;
2684	begin	2688	begin
2685	result := false;	2689	result := false;
2686		2690
Line 2700...	Line 2704...
2700	begin	2704	begin
2701	// Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo	2705	// Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
2702		2706
2703	// See comment at RecyclerSpecificIsNukeOnDelete()	2707	// See comment at RecyclerSpecificIsNukeOnDelete()
2704		2708
2705	dump := _registryReadDump(reg, 'PurgeInfo');	2709	dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
2706	result := GetAnsiCharBit(dump[68], 3);	2710	result := GetAnsiCharBit(dump[68], 3);
2707	end	2711	end
2708	else	2712	else
2709	begin	2713	begin
2710	// Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo	2714	// Windows 95 - Standardwerte sind gegeben, deswegen existiert kein PurgeInfo
Line 2720...	Line 2724...
2720	end;	2724	end;
2721		2725
2722	function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;	2726	function RecyclerSpecificIsNukeOnDelete(Drive: Char): boolean;
2723	var	2727	var
2724	reg: TRegistry;	2728	reg: TRegistry;
2725	dump: string;	2729	dump: AnsiString;
2726	d: Byte;	2730	d: Byte;
2727	const	2731	const
2728	RES_DEFAULT = false;	2732	RES_DEFAULT = false;
2729	begin	2733	begin
2730	result := false;	2734	result := false;
Line 2749...	Line 2753...
2749	begin	2753	begin
2750	if reg.ValueExists('PurgeInfo') then	2754	if reg.ValueExists('PurgeInfo') then
2751	begin	2755	begin
2752	// Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo	2756	// Windows 95 - Verschlüsselte Informationen liegen in PurgeInfo
2753		2757
2754	dump := _registryReadDump(reg, 'PurgeInfo');	2758	dump := AnsiString(_registryReadDump(reg, 'PurgeInfo'));
2755		2759
2756	// NOT tested, only theoretical! My idea about the possible structure is:	2760	// NOT tested, only theoretical! My idea about the possible structure is:
2757	//	2761	//
2758	// Byte 0x40 0x41 0x42 0x43	2762	// Byte 0x40 0x41 0x42 0x43
2759	// Bit 76543210 76543210 76543210 76543210	2763	// Bit 76543210 76543210 76543210 76543210
Line 2946...	Line 2950...
2946	end	2950	end
2947	else	2951	else
2948	begin	2952	begin
2949	// Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)	2953	// Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005)
2950	// if Path is a floppy or CD drive...	2954	// if Path is a floppy or CD drive...
-		2955	// Windows 10: Error 0x8007003 for Path 'C:\'
2951	raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);	2956	raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]);
2952	end;	2957	end;
2953	end	2958	end
2954	else	2959	else
2955	raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);	2960	raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]);

Subversion Repositories recyclebinunit

recyclebinunit/trunk/Recycle Bin Unit/RecyclerFunctions.pas – Rev 80 → 91