Корзина

Восстановление файла из корзины

2017-10-08T23:20:01+07:00

Code:

{©Drkb v.3}

// Функция восстанавливает выбранный в ListView элемент из корзины...

function RestoreElement(const AHandle: THandle; LV: TListView): Boolean;

function GetLVItemText(const Index: Integer): String;

begin

if Index = 0 then

Result := LV.Selected.Caption

else

Result := LV.Selected.SubItems.Strings[Index - 1];

end;

var

ppidl, Item: PItemIDList;

Desktop: IShellFolder;

RecycleBin: IShellFolder2;

RecycleBinEnum: IEnumIDList;

Fetched, I: Cardinal;

Details: TShellDetails;

Mallok: IMalloc;

Valid: Boolean;

Context: IContextMenu;

AInvokeCommand: TCMInvokeCommandInfo;

begin

Result := False;

if LV = nil then Exit;

if SHGetMalloc(Mallok) = S_OK then

if SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then

if SHGetDesktopFolder(Desktop) = S_OK then

if Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then

if RecycleBin.EnumObjects(AHandle,

SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, RecycleBinEnum) = S_OK then

begin

// Перечиляем содержимое корзины

while True do

begin

RecycleBinEnum.Next(1, Item, Fetched);

if Fetched = 0 then Break;

Valid := False;

for I := 0 to DETAIL_COUNT - 1 do

if RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then

try

// Ищем нужный нам элемент

Valid := GetLVItemText(I) = StrRetToString(Item, Details.str);

if not Valid then Break;

finally

Mallok.Free(Details.str.pOleStr);

end;

// Если выделенный элемент найден

if Valid then

begin

// Восстанавливаем его при помощи интерфейса IContextMenu

if RecycleBin.GetUIObjectOf(AHandle, 1, Item,

IID_IContextMenu, nil, Pointer(Context)) = S_OK then

begin

FillMemory(@AInvokeCommand, SizeOf(AInvokeCommand), 0);

with AInvokeCommand do

begin

cbSize := SizeOf(AInvokeCommand);

hwnd := AHandle;

// - локализация не нужна...

lpVerb := 'undelete'; // - восстановление фийла из корзины...

//lpVerb := 'properties'; // - показ диалога свойства...

//lpVerb := 'delete'; // - удаление файла из корзины...

fMask := 0;

lpDirectory := PChar(LV.Selected.SubItems.Strings[0]);

nShow := SW_SHOWNORMAL;

end;

Result := Context.InvokeCommand(AInvokeCommand) = S_OK;

Break;

end;

procedure TForm1.mnuRestoreClick(Sender: TObject);

begin

if ListView1.Selected <> nil then

if RestoreElement(Handle, ListView1) then ShowMessage('Элемент успешно восстановлен.');

end;

Как получить количество файлов в корзине и их размер?

2017-10-08T22:53:10+07:00

Code:

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;

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;

{

The SHQueryRecycleBin API used in this method is

only available on systems with the latest shell32.dll installed with IE4 /

Active Desktop.

}

Очистка корзины

2017-10-08T22:55:26+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

const

SHERB_NOCONFIRMATION = $1;

SHERB_NOPROGRESSUI = $2;

SHERB_NOSOUND = $4;

type

TForm1 = class(TForm)

btnGetRecicleBinFileCount: TButton;

btnEmptyRecicleBin: TButton;

btnDelToReciclebin: TButton;

procedure btnGetRecicleBinFileCountClick(Sender: TObject);

procedure btnEmptyRecicleBinClick(Sender: TObject);

procedure btnDelToReciclebinClick(Sender: TObject);

end;

type

TSHQueryRBInfo = packed record

cbSize : DWORD;

i64Size,

i64NumItems : TLargeInteger;

end;

PSHQueryRBInfo = ^TSHQueryRBInfo;

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

dwFlags: DWORD): HRESULT; stdcall;

external 'shell32.dll' name 'SHEmptyRecycleBinA';

function SHQueryRecycleBin (pszRootPath: PChar;

var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

external 'Shell32.dll' name 'SHQueryRecycleBinA';

var

Form1: TForm1;

implementation

{$R *.dfm}

// Очистка корзины

procedure TForm1.btnEmptyRecicleBinClick(Sender: TObject);

var

Err: HRESULT;

begin

Err := SHEmptyRecycleBin(Handle, 'c:\', SHERB_NOSOUND);

if Err <> S_OK then ShowMessage(SysErrorMessage(Err));

end;

end.

Получение информации о папках и файлах находящихся на данный момент в корзине

2017-10-08T23:19:05+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI, ShlObj, ActiveX, ComCtrls, Menus;

// корзина отображает не всю информацию по удаленному элементу

// а только 6 позиций.

// в действительности этих позиций больше...

const

DETAIL_COUNT = 11;

type

TForm1 = class(TForm)

Button1: TButton;

ListView1: TListView;

PopupMenu1: TPopupMenu;

mnuRestore: TMenuItem;

procedure Button1Click(Sender: TObject);

procedure mnuRestoreClick(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

// Функция взята из QDialogs...

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet;

Flag: String = ''): String;

var

P: PChar;

begin

case StrRet.uType of

STRRET_CSTR:

SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));

STRRET_OFFSET:

begin

P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];

SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);

end;

STRRET_WSTR:

if Assigned(StrRet.pOleStr) then

Result := StrRet.pOleStr

else

Result := '';

end;

{ This is a hack bug fix to get around Windows Shell Controls returning

spurious "?"s in date/time detail fields }

if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then

Result := StringReplace(Result, '?', '', [rfReplaceAll]);

end;

// Смотрим содержимое корзины...

function ViewRecycleBin(const AHandle: THandle; LV: TListView): Boolean;

var

ppidl, Item: PItemIDList;

Desktop: IShellFolder;

RecycleBin: IShellFolder2;

RecycleBinEnum: IEnumIDList;

Fetched, I: Cardinal;

Details: TShellDetails;

Mallok: IMalloc;

TmpStr: ShortString;

begin

Result := False;

if LV = nil then Exit;

LV.Clear;

LV.Columns.Clear;

LV.ViewStyle := vsReport;

if SHGetMalloc(Mallok) = S_OK then

if SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then

if SHGetDesktopFolder(Desktop) = S_OK then

if Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then

if RecycleBin.EnumObjects(AHandle,

SHCONTF_FOLDERS or SHCONTF_NONFOLDERS, RecycleBinEnum) = S_OK then

begin

// Создаем колонки

for I := 0 to DETAIL_COUNT - 1 do

if RecycleBin.GetDetailsOf(nil, I, Details) = S_OK then

try

with LV.Columns.Add do

begin

Caption := StrRetToString(Item, Details.str);

Width := LV.Canvas.TextWidth(Caption) + 24;

end;

finally

Mallok.Free(Details.str.pOleStr);

end;

// Перечиляем содержимое корзины

while True do

begin

RecycleBinEnum.Next(1, Item, Fetched);

if Fetched = 0 then Break;

if RecycleBin.GetDetailsOf(Item, 0, Details) = S_OK then

begin

try

TmpStr := StrRetToString(Item, Details.str);

finally

Mallok.Free(Details.str.pOleStr);

end;

with LV.Items.Add do

begin

Caption := TmpStr;

for I := 1 to DETAIL_COUNT - 1 do

if RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then

try

SubItems.Add(StrRetToString(Item, Details.str));

finally

Mallok.Free(Details.str.pOleStr);

end;

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ViewRecycleBin(Handle, ListView1);

end;

end.

Просмотр состояния корзины

2017-10-08T22:54:18+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

const

SHERB_NOCONFIRMATION = $1;

SHERB_NOPROGRESSUI = $2;

SHERB_NOSOUND = $4;

type

TForm1 = class(TForm)

btnGetRecicleBinFileCount: TButton;

btnEmptyRecicleBin: TButton;

btnDelToReciclebin: TButton;

procedure btnGetRecicleBinFileCountClick(Sender: TObject);

procedure btnEmptyRecicleBinClick(Sender: TObject);

procedure btnDelToReciclebinClick(Sender: TObject);

end;

type

TSHQueryRBInfo = packed record

cbSize : DWORD;

i64Size,

i64NumItems : TLargeInteger;

end;

PSHQueryRBInfo = ^TSHQueryRBInfo;

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

dwFlags: DWORD): HRESULT; stdcall;

external 'shell32.dll' name 'SHEmptyRecycleBinA';

function SHQueryRecycleBin (pszRootPath: PChar;

var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

external 'Shell32.dll' name 'SHQueryRecycleBinA';

var

Form1: TForm1;

implementation

{$R *.dfm}

// Просмотр состояния корзины (краткая информация)

procedure TForm1.btnGetRecicleBinFileCountClick(Sender: TObject);

var

Info: TSHQueryRBInfo;

Err: HRESULT;

begin

ZeroMemory(@Info, SizeOf(Info));

Info.cbSize := SizeOf(Info);

Err := SHQueryRecycleBin(nil, Info);

if Err = S_OK then

ShowMessage(Format('Всего в корзине %d эелементов, их общий размер: %d',

[Info.i64NumItems, Info.i64Size]))

else

ShowMessage(SysErrorMessage(Err));

end;

end.

Удаление файла в корзину

2017-10-08T23:17:51+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

const

SHERB_NOCONFIRMATION = $1;

SHERB_NOPROGRESSUI = $2;

SHERB_NOSOUND = $4;

type

TForm1 = class(TForm)

btnGetRecicleBinFileCount: TButton;

btnEmptyRecicleBin: TButton;

btnDelToReciclebin: TButton;

procedure btnGetRecicleBinFileCountClick(Sender: TObject);

procedure btnEmptyRecicleBinClick(Sender: TObject);

procedure btnDelToReciclebinClick(Sender: TObject);

end;

type

TSHQueryRBInfo = packed record

cbSize : DWORD;

i64Size,

i64NumItems : TLargeInteger;

end;

PSHQueryRBInfo = ^TSHQueryRBInfo;

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

dwFlags: DWORD): HRESULT; stdcall;

external 'shell32.dll' name 'SHEmptyRecycleBinA';

function SHQueryRecycleBin (pszRootPath: PChar;

var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

external 'Shell32.dll' name 'SHQueryRecycleBinA';

var

Form1: TForm1;

implementation

{$R *.dfm}

// Удаление файла в корзину...

procedure TForm1.btnDelToReciclebinClick(Sender: TObject);

var

Struct: TSHFileOpStruct;

Err: HRESULT;

begin

with Struct do

begin

Wnd := Handle;

wFunc := FO_DELETE;

pFrom := 'c:\1.txt';

pTo := nil;

fFlags := FOF_ALLOWUNDO;

fAnyOperationsAborted := True;

hNameMappings := nil;

lpszProgressTitle := nil;

end;

Err := SHFileOperation(Struct);

if Err <> S_OK then ShowMessage(SysErrorMessage(Err));

end;

end.