unit Papierkorb;
interface
uses Windows,Contnrs,Forms,Classes,SysUtils,ShellAPI,Masks,COMObj,shlobj,
ActiveX;
type
TPIDLItem =
class
private
FDateiname:
String;
FIDL : PItemIDList;
protected
public
end;
type
TPapierkorb =
class
private
FPIDLListe: TObjectList;
FDeskDirI : IShellFolder;
FRecycleI : IShellFolder;
FpReIDL : PItemIDList;
FpNextIDL : PItemIDList;
FpItemIDL : PItemIDList;
FEnumList : IENUMIDLIST;
FCmInfo : CMINVOKECOMMANDINFO;
FContextI : IContextMenu;
FIsThere : Cardinal;
FStrRet : TStrRet;
FparName :
String;
FPIDLItem : TPIDLItem;
procedure SetzePapierkorbInterface;
procedure NeueDatei(
var PPIDLItem:TPIDLItem);
function ListePapierkorbDateienAuf(Maske:
string = '
'):Boolean;
function PKDateiWiederhergestellt(ListNr:integer;Dateiname:
string):Boolean;
function DateiInPKGefunden(Dateiname:
string;
var ListNr:integer):Boolean;
function VerschiebeDateiInPK(
var Dateiname:
string;PlusNull:Boolean):Boolean;
protected
public
constructor Create();
destructor Destroy();
override;
function ErstellePKDateiListe(
const DateiListe:TStringList;Maske:
string = '
'):Boolean;
function StellePKDateiWiederHer(Dateiname:
string):Boolean;
function ErmittleAnzPKDateien(Maske:
string = '
'):integer;
function LeerePapierkorb:Boolean;
function DateiInPapierkorb(Dateiname:
string): Boolean;
end;
function SHEmptyRecycleBin(Wnd:HWnd; LPCTSTR:PChar; DWORD:Word):Integer;
stdcall;
function SHEmptyRecycleBin;
external '
SHELL32.DLL'
name '
SHEmptyRecycleBinA';
implementation
constructor TPapierkorb.Create;
begin
inherited Create;
FPIDLListe := TObjectList.Create;
end;
destructor TPapierkorb.Destroy;
begin
FPIDLListe.Free;
FPIDLListe :=
nil;
inherited;
end;
function TPapierkorb.ErstellePKDateiListe(
const DateiListe:TStringList;Maske:
string = '
'):Boolean;
var i:integer;
begin
SetzePapierkorbInterface;
Result := ListePapierkorbDateienAuf(Maske);
If Result
then begin
For i := 0
to FPIDLListe.Count - 1
do
DateiListe.Add(TPIDLItem(FPIDLListe[i]).FDateiname);
end;
end;
function TPapierkorb.StellePKDateiWiederHer(Dateiname:
string):Boolean;
var ListNr:integer;
begin
SetzePapierkorbInterface;
ListePapierkorbDateienAuf;
Result := DateiInPKGefunden(Dateiname,ListNr)
and PKDateiWiederhergestellt(ListNr,Dateiname);
end;
function TPapierkorb.ErmittleAnzPKDateien(Maske:
string = '
'):integer;
begin
SetzePapierkorbInterface;
If ListePapierkorbDateienAuf(Maske)
then Result := FPIDLListe.Count
else Result := -1;
end;
function TPapierkorb.DateiInPKGefunden(Dateiname:
string;
var ListNr:integer):Boolean;
var i:integer;
begin
ListNr := -1;
Try
For i := 0
to FPIDLListe.Count - 1
do begin
If SameFileName(TPIDLItem(FPIDLListe[i]).FDateiname,Dateiname)
then begin
ListNr := i;
break;
end;
end;
Finally
Result := (ListNr > -1);
End;
end;
function TPapierkorb.PKDateiWiederhergestellt(ListNr:integer;Dateiname:
string):Boolean;
begin
Try
FpItemIDL := TPIDLItem(FPIDLListe[ListNr]).FIDL;
If FpItemIDL <>
nil then begin
ZeroMemory(@FCmInfo, SizeOf(FCmInfo));
FCmInfo.cbSize:= SizeOf(FCmInfo);
FCmInfo.fMask:= CMIC_MASK_FLAG_NO_UI;
FCmInfo.hwnd:= Application.Handle;
FCmInfo.lpVerb:= '
undelete';
FCmInfo.nShow:= SW_SHOWDEFAULT;
OleCheck(FRecycleI.GetUIObjectOf(Application.Handle, 1, FpItemIDL, IID_IContextMenu,
nil, FContextI));
OleCheck(FContextI.InvokeCommand(FCmInfo));
end;
Except
CoTaskMemFree(FpItemIDL);
end;
// Result := True;
Result := FileExists(Dateiname);
end;
function TPapierkorb.ListePapierkorbDateienAuf(Maske:
string = '
'):Boolean;
begin
Result := True;
Try
OleCheck(FRecycleI.EnumObjects(Application.Handle, SHCONTF_FOLDERS
or SHCONTF_NONFOLDERS
or SHCONTF_INCLUDEHIDDEN, FEnumList));
While FEnumList.Next(1, FpNextIDL, FIsThere) = S_OK
do begin
If FIsThere > 0
then begin
OleCheck(FRecycleI.GetDisplayNameOf(FpNextIDL, SHGDN_NORMAL, FStrRet));
case FStrRet.uType
of
STRRET_CSTR: FparName := FStrRet.cStr;
STRRET_OFFSET: FparName := PChar(Cardinal(FpNextIDL) + FStrRet.uOffset);
STRRET_WSTR: FparName := FStrRet.pOleStr;
end;
end;
If FpNextIDL <>
nil then begin
If (Maske = '
')
or MatchesMask(FparName,Maske)
then begin
FPIDLItem := TPIDLItem.Create;
FPIDLItem.FDateiname := FparName;
FPIDLItem.FIDL := FpNextIDL;
NeueDatei(FPIDLItem);
end;
end;
end;
except
Result := False;
end;
CoTaskMemFree(FpNextIDL);
end;
procedure TPapierkorb.NeueDatei(
var PPIDLItem:TPIDLItem);
begin
FPIDLListe.Add(PPIDLItem);
end;
function TPapierkorb.LeerePapierkorb:Boolean;
const
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;
begin
Result := (SHEmptyRecycleBin(0,
nil, SHERB_NOCONFIRMATION
or SHERB_NOPROGRESSUI
or SHERB_NOSOUND) = 0);
end;
function TPapierkorb.DateiInPapierkorb(Dateiname:
string): Boolean;
begin
Result := FileExists(Dateiname);
If Result
then begin
// Erst kein, dann ein, und dann zwei Nullzeichen hinter den Dateinamen setzen -> drei Mal ist Bremer Recht!
Result := VerschiebeDateiInPK(Dateiname,False);
If not Result
then begin
Result := VerschiebeDateiInPK(Dateiname,True);
If not Result
then Result := VerschiebeDateiInPK(Dateiname,True);
end;
end;
end;
function TPapierkorb.VerschiebeDateiInPK(
var Dateiname:
string;PlusNull:Boolean):Boolean;
var DatStrukt: TSHFileOpStruct; Ergebnis:integer;
begin
// Es müssen ZWEI Nullzeichen am Dateiende sein, das klappt nicht immer
If PlusNull
then Dateiname := Dateiname + #0;
FillChar(DatStrukt, SizeOf(DatStrukt), 0);
DatStrukt.wFunc := FO_DELETE;
DatStrukt.pFrom := PChar(Dateiname);
DatStrukt.fFlags := FOF_ALLOWUNDO
or FOF_NOCONFIRMATION
or FOF_SILENT;
Ergebnis := ShFileOperation(DatStrukt);
Result := (Ergebnis = 0);
end;
procedure TPapierkorb.SetzePapierkorbInterface;
begin
OleCheck(SHGetDesktopFolder(FDeskDirI));
OleCheck(SHGetSpecialFolderLocation(Application.Handle, CSIDL_BITBUCKET, FpReIDL));
OleCheck(FDeskDirI.BindToObject(FpReIDL,
nil, IShellFolder, FRecycleI));
CoTaskMemFree(FpReIDL);
end;
end.