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
      Quellen:=Quellen+QuellDateien[i]+#0;
    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
    for i:=0 to OpenDlg.Files.Count-1 do
      FileList.Items.Add(OpenDlg.Files[i]);
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
    Move:=Tag=1;
  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.