檔案批次複製、刪除

private
    { Private declarations }
    procedure _XCopy(ASourceDir:String; ADestDir:String);
    procedure _Move(ASourceDir:String; ADestDir:String);
    procedure _DelTree(ASourceDir:String);

//---------------------------------------------------------------------------
procedure TForm1._XCopy(ASourceDir:String; ADestDir:String);
var
FileRec:TSearchrec;
Sour:String;
Dest:String;
begin
    Sour:=ASourceDir;
    Dest:=ADestDir;

    if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';
    if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';

    if not DirectoryExists(ASourceDir) then
    begin
        ShowMessage('來源目錄不存在!!');
        exit;
    end;

    if not DirectoryExists(ADestDir) then
    begin
        ForceDirectories(ADestDir);
    end;

    if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
    repeat
        if ((FileRec.Attr and faDirectory) <> 0) then
        begin
        if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
        begin
        _XCopy(Sour+FileRec.Name,Dest+FileRec.Name);
        end;
        end
        else
        begin
        CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);
        end;
    until FindNext(FileRec)<>0;

    FindClose(FileRec);

end;
//---------------------------------------------------------------------------
procedure TForm1._Move(ASourceDir:String; ADestDir:String);
var
FileRec:TSearchrec;
Sour:String;
Dest:String;
begin
    Sour:=ASourceDir;
    Dest:=ADestDir;

    if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';
    if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';

    if not DirectoryExists(ASourceDir) then
    begin
        ShowMessage('來源目錄不存在!!');
        exit;
    end;

    if not DirectoryExists(ADestDir) then
    begin
        ForceDirectories(ADestDir);
    end;

    if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
    repeat
        if ((FileRec.Attr and faDirectory) <> 0) then
        begin
        if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
        begin
        _XCopy(Sour+FileRec.Name,Dest+FileRec.Name);

        _DelTree(Sour+FileRec.Name);

        FileSetAttr(Sour+FileRec.Name,faArchive);
        RemoveDir(Sour+FileRec.Name);
        end;
        end
        else
        begin
        CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);

        FileSetAttr(Sour+FileRec.Name,faArchive);
        deletefile(Sour+FileRec.Name);
        end;
    until FindNext(FileRec)<>0;

    FindClose(FileRec);

    FileSetAttr(Sour,faArchive);
    RemoveDir(Sour);

end;
//---------------------------------------------------------------------------
procedure TForm1._DelTree(ASourceDir:String);
var
FileRec:TSearchrec;
Sour:String;
begin
    Sour:=ASourceDir;
    if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';

    if not DirectoryExists(ASourceDir) then
    begin
        ShowMessage('來源目錄不存在!!');
        exit;
    end;

    if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
    repeat
        //if (FileRec.Attr = faDirectory) then
        if ((FileRec.Attr and faDirectory) <> 0) then
        begin
        if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
        begin
        _DelTree(Sour+FileRec.Name);

        FileSetAttr(Sour+FileRec.Name,faArchive);
        RemoveDir(Sour+FileRec.Name);
        end;
        end
        else
        begin
        FileSetAttr(Sour+FileRec.Name,faArchive);
        deletefile(Sour+FileRec.Name);
        end;
    until FindNext(FileRec)<>0;

    FindClose(FileRec);

    FileSetAttr(Sour,faArchive);
    RemoveDir(Sour);

end;