افراغ سلة المحذوفات

[code] 
unit Unit1; 
interface 
uses 
Windows, Messages, SysUtils, Classes, 
Graphics, ShellApi,Controls, Forms, 
Dialogs,StdCtrls, ExtCtrls; 
type 
TForm1 = class(TForm) 
Button1: TButton; 
procedure Button1Click(Sender: TObject); 
end; 

var Form1: TForm1; 

function SHEmptyRecycleBin 
(Wnd:HWnd; LPCTSTR:PChar; 
DWORD:Word):Integer; stdcall; 

const 
SHERB_NOCONFIRMATION = $00000001; 
SHERB_NOPROGRESSUI = $00000002; 
SHERB_NOSOUND = $00000004; 

implementation {$R *.DFM} 

function SHEmptyRecycleBin; external 
'SHELL32.DLL' name 'SHEmptyRecycleBinA'; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
SHEmptyRecycleBin(self.handle,'', 
SHERB_NOCONFIRMATION); 
end; 
end. 
[code/]

جميل

وحبذا نقلها إلى موضوع الأفكار السريعة

الله عليكم يا اهل الدلفي .... وصل العجز فيكم لأفراغ سلة المحذوفات برمجيآ ... :D

طيب خذ هذا الكود لتأكد من السلة فارغة او لا قبل الخذف :

uses
  Activex, ShlObj, ComObj;


function RecycleBinIsEmpty: Boolean;
const
  CLSID_IRecycleBin: TGUID = (D1: $645FF040; D2: $5081; D3: $101B;
    D4: ($9F, $08, $00, $AA, $00, $2F, $95, $4E));
var
  EnumIDList: IEnumIDList;
  FileItemIDList: PItemIDList;
  ItemCount: ULONG;
  RecycleBin: IShellFolder;
begin
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_IRecycleBin, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IID_IShellFolder, RecycleBin));
  RecycleBin.EnumObjects(0,
    SHCONTF_FOLDERS or
    SHCONTF_NONFOLDERS or
    SHCONTF_INCLUDEHIDDEN,
    EnumIDList);
  Result := EnumIDList.Next(1, FileItemIDList, ItemCount) <> NOERROR;
  CoUninitialize;
end;

وهذا لمعرفة عدد الملفات الموجودة في السلة وحجمها الكلي :

type
  PSHQueryRBInfo = ^TSHQueryRBInfo;
  TSHQueryRBInfo = packed record
    cbSize: DWORD;
    // Size of the structure, in bytes.
    // This member must be filled in prior to calling the function.
    i64Size: Int64;
    // Total size of all the objects in the specified Recycle Bin, in bytes.
    i64NumItems: Int64;
    // Total number of items in the specified Recycle Bin.
  end;

const
  shell32 = 'shell32.dll';

function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;
  stdcall; external shell32 Name 'SHQueryRecycleBinA';

function GetDllVersion(FileName: string): Integer;
var
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
begin
  Result   := 0;
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
          Result := FI.dwFileVersionMS;
    finally
      FreeMem(VerBuf);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  DllVersion: integer;
  SHQueryRBInfo: TSHQueryRBInfo;
  r: HResult;
begin
  DllVersion := GetDllVersion(PChar(shell32));
  if DllVersion >= $00040048 then
  begin
    FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);
    SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
    R := SHQueryRecycleBin(nil, @SHQueryRBInfo);
    if r = s_OK then
    begin
      label1.Caption := Format('Size:%d Items:%d',
        [SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);
    end
    else
      label1.Caption := Format('Err:%x', [r]);
  end;
end;

من الواضح ان مجرد وجود الاخ 02/11/2004 يثير الشهية

هذا الكود للحذف

Uses

  ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
var
  T: TSHFileOpStruct;
  P: string;
begin
  P := 'C:\s.jpg';
  with T do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := Pchar(P);
    fFlags := FOF_ALLOWUNDO
  end;
  SHFileOperation(T);
  end;
end.

وهذا لتصفية السلة نهائيا

procedure EmptyRecycleBin;
 const
   SHERB_NOCONFIRMATION = $00000001;
   SHERB_NOPROGRESSUI = $00000002;
   SHERB_NOSOUND = $00000004;
 type
   TSHEmptyRecycleBin = function(Wnd: HWND;
                                 pszRootPath: PChar;
                                 dwFlags: DWORD): HRESULT;  stdcall;
 var
   SHEmptyRecycleBin: TSHEmptyRecycleBin;
   LibHandle: THandle;
 begin  { EmptyRecycleBin }
   LibHandle := LoadLibrary(PChar('Shell32.dll'));
   if LibHandle <> 0 then @SHEmptyRecycleBin :=
       GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
   else
   begin
     MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
     Exit;
   end;

   if @SHEmptyRecycleBin <> nil then
     SHEmptyRecycleBin(Application.Handle,
                       nil,
                       SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
   FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;
 end;



 procedure TForm1.Button1Click(Sender: TObject);
 begin
   EmptyRecycleBin;
 end;

وهذا لعرض المحتويات

uses
   ActiveX, ShlObj, ShellApi;

 procedure FreePidl(pidl: PItemIDList);
 var
    allocator: IMalloc;
 begin
   if Succeeded(shlobj.SHGetMalloc(allocator)) then
    begin
     allocator.Free(pidl);
     {$IFDEF VER90}
     allocator.Release;
     {$ENDIF}
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   exInfo: TShellExecuteInfo;
 begin
   // initialize all fields to 0 
  FillChar(exInfo, SizeOf(exInfo), 0);
   with exInfo do
   begin
     cbSize := SizeOf(exInfo); // required! 
    fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST;
     Wnd := Handle;
     nShow := SW_SHOWNORMAL;
     lpVerb := 'open';
     ShGetSpecialFolderLocation(Handle, CSIDL_BITBUCKET, PItemIDLIst(lpIDList));
   end;
   ShellExecuteEx(@exInfo);
   FreePIDL(exinfo.lpIDList);
 end;

وهذا كود اخرى للحذف

procedure EmptyRecycleBin;
Type
  TSHEmptyRecycleBin = function (hWnd: HWND; LPCTSTR: PChar; DWORD: Word):integer; stdcall;
const
  SHERB_NOCONFIRMATION = $00000001;
  SHERB_NOPROGRESSUI   = $00000002;
  SHERB_NOSOUND        = $00000004;

Var
  LibHandle           : THandle;
  SHEmptyRecycleBin  : TSHEmptyRecycleBin;
begin
  LibHandle := LoadLibrary(PChar('Shell32.dll'));
  if LibHandle = 0 then
    Raise Exception.Create('Cannot load Shell32.DLL');

  @SHEmptyRecycleBin := GetProcAddress(LibHandle, 'SHEmptyRecycleBinA');

  if @SHEmptyRecycleBin = nil then
  begin
    FreeLibrary(LibHandle);
    Raise Exception.Create('Cannot find SHEmptyRecycleBinA in Shell32.DLL');
  end;

 SHEmptyRecycleBin(Application.Handle,'',SHERB_NOCONFIRMATION or
SHERB_NOPROGRESSUI or SHERB_NOSOUND);

 FreeLibrary(LibHandle);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
EmptyRecycleBin;
end;

end.

:rolleyes: