Arbeiten mit Dateien für Fortgeschrittene.


Hier die etwas komplizierteren, aber auch mächtigeren Möglichkeiten der API-Funktion SHFileOperation und SHBrowseForFolder. Unter anderem geht es darum, beim Kopieren den entsprechenden Windows-Dialog (mit den fliegenden Dateien) anzuzeigen, oder Dateien beim Löschen in den Papierkorb zu verschieben.

unit SHD_Main;

// Demonstration der API-Funktionen SHFileOperation und SHBrowseForFolder.
// Zusammengebastelt von Simon Reinhardt S.Reinhardt@WTal.de

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, FileCtrl, ShellAPI, ShlObj;

type
  TMainForm = class(TForm)
    BtnLoeschen: TBitBtn;
    BtnKopieren: TBitBtn;
    BtnVerschieben: TBitBtn;
    FileList: TListBox;
    BtnSuchen: TBitBtn;
    OpenDlg: TOpenDialog;
    BtnListeLoeschen: TBitBtn;
    procedure BtnSuchenClick(Sender: TObject);
    procedure BtnListeLoeschenClick(Sender: TObject);
    procedure BtnLoeschenClick(Sender: TObject);
    procedure BtnKopierenClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

function GetFolder(Root:integer;Caption:string):string;
var bi : TBROWSEINFO;
    lpBuffer : PChar;
    pidlPrograms, pidlBrowse : PItemIDList;
begin
  if (not SUCCEEDED(SHGetSpecialFolderLocation(getactivewindow,Root,pidlPrograms))) then
    Exit;
  lpBuffer := StrAlloc(max_path);
  bi.hwndOwner := getactivewindow;
  bi.pidlRoot := pidlPrograms;
  bi.pszDisplayName := lpBuffer;
  bi.lpszTitle := pChar(caption);
  bi.ulFlags := BIF_RETURNONLYFSDIRS;
  bi.lpfn := nil;
  bi.lParam := 0;
  pidlBrowse := SHBrowseForFolder(bi);
  if (pidlBrowse<><>nil) then begin
    if (SHGetPathFromIDList(pidlBrowse, lpBuffer)) then
      Result:=lpBuffer;
  end;
  StrDispose(lpBuffer);
end; {GetFolder}

function FileOperation(QuellDateien:TStrings;Zielverz:string;Action:integer):boolean;
var Operation : TSHFileOpStruct;
    i : integer;
    Quellen : string;
begin
  with Operation do begin
    {Parent Window}
    wnd := Application.Handle;
    {was soll gemacht werden?}
    wFunc := Action;

    {Quelldateien nach pFrom kopieren}
    Quellen := '';
    for i := 0 to QuellDateien.Count-1 do begin
      Quellen:=Quellen+QuellDateien[i]+#0;
    end;
    Quellen := Quellen+#0;
    pFrom := PChar(Quellen);

    {Zielverzeichnis nach pTo kopieren}
    pTo := PChar(ZielVerz);

    {Titel der Fortschrittanzeige}
    case Action of
      FO_Delete : lpszProgressTitle:='Dateien löschen';
      FO_Copy   : lpszProgressTitle:='Dateien kopieren';
      FO_Move   : lpszProgressTitle:='Dateien verschieben';
      FO_Rename : lpszProgressTitle:='Dateien umbenennen';
    end;
{   Flags für die Aktion einstellen

    ohne Fortschrittanzeige:
    fFlags := FOF_AllowUndo or FOF_Silent;

    ohne Bestätigung :
    fFlags := FOF_AllowUndo or FOF_NoConfirmation

    z.B. klammheimlich in den Papierkorb verschieben:
    fFlags := FOF_AllowUndo or FOF_Silent or FOF_NoConfirmation}

    fFlags := FOF_AllowUndo;
  end;

  {Und los gehts!}
  Result := SHFileOperation(Operation)=0;
end;

procedure TMainForm.BtnSuchenClick(Sender: TObject);
var i : integer;
begin
  if OpenDlg.Execute then begin
    for i := 0 to OpenDlg.Files.Count-1 do begin
      FileList.Items.Add(OpenDlg.Files[i]);
    end;
  end;
end;

procedure TMainForm.BtnListeLoeschenClick(Sender: TObject);
begin
  FileList.Clear;
end;

procedure TMainForm.BtnLoeschenClick(Sender: TObject);
begin
  FileOperation(FileList.Items,'',FO_Delete);
  FileList.Clear;
end;

procedure TMainForm.BtnKopierenClick(Sender: TObject);
var ZielVerz : string;
    Move : boolean;
begin
  with Sender as TBitBtn do begin
    Move:=Tag=1;
  end;
  ZielVerz:=GetFolder(CSIDL_Drives,'Zielverzeichnis auswählen:');
  if ZielVerz<>'' then begin
    if ZielVerz[Length(ZielVerz)]<>'\' then
      ZielVerz:=ZielVerz+'\';
    if Move then
      FileOperation(FileList.Items,ZielVerz,FO_Move)
    else
      FileOperation(FileList.Items,ZielVerz,FO_Copy);
    FileList.Clear;
  end;
end;

end.
Delphi 1 Delphi 2 Delphi 3 Delphi 4
nicht getestet Version nicht betroffen getestet

siehe auch:

Arbeiten mit Dateien (löschen, kopieren, verschieben...).
Wie kann ich alle Dateien in einem Verzeichnis löschen?


Delphi FAQ