fdircopyunit.~pas

DELPHI 下远程控制源码

unit FDirCopyUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls,StrUtils, IdGlobal;

type
  TFDirCopyFm = class(TForm)
    Edit3: TEdit;
    Label6: TLabel;
    Label5: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Edit1: TEdit;
    Animate1: TAnimate;
    ProgressBar1: TProgressBar;
    Panel1: TPanel;
    BitBtn3: TBitBtn;
    BitBtn1: TBitBtn;
    Edit4: TEdit;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Edit4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
	 //本地文件复制-----进度自理型  
      procedure LFileCopy(SF,DF:String);
  public
    { Public declarations }
    procedure DoDirCopy;
  end;

var
  FDirCopyFm: TFDirCopyFm;

implementation

{$R *.dfm}
uses Unit1UseUnit;
procedure TFDirCopyFm.LFileCopy(SF,DF:String);
var
  FromF, ToF: file;
  NumRead, NumWritten:integer;
  Buf: array[1..32768] of Char;
  FileLen,CopyCount:int64;
begin
    AssignFile(FromF,SF);
    FileMode:=0;
    Reset(FromF, 1);
    FileLen:=FileSize(FromF);
    if FileLen=0 then
    begin
       Application.MessageBox(PChar(Edit3.Text+Edit1.Text),
			      '操作失败，请检查该文件是否存在内容。',
			      MB_OK+MB_ICONSTOP);
       CloseFile(FromF);			      
       exit;
    end;
    ProgressBar1.Max:=FileLen;
    AssignFile(ToF,DF);
    FileMode:=2;
    Rewrite(ToF, 1);
    CopyCount:=0;
    repeat
	Application.ProcessMessages; 	
	if Self.Tag=0 then //tag=0 是停止标志
	begin
	  CloseFile(FromF);
	  CloseFile(ToF);
	  Animate1.Active:=False;
	  exit;	  
	end;
	BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
	BlockWrite(ToF, Buf, NumRead, NumWritten);
	CopyCount:=CopyCount+NumRead;
	ProgressBar1.Position:=CopyCount;
	if FileLen<>0 then
	     Self.Caption:='正在拷贝文件：'+IntToStr(CopyCount*100 
	                                             div FileLen)+'%';
    until (NumRead = 0) or (NumWritten <> NumRead);
    CloseFile(FromF);
    CloseFile(ToF);   
end;
procedure TFDirCopyFm.DoDirCopy;
var
  SFileList           :TStringList;
  SourceDir,TargetDir :String;  
  TargetFile          :String;
  i,iLen              :integer;
  tempStr1,tempStr2   :String;
  TatolFilesStr       :String;
begin
  SourceDir:=Edit3.Text;
  TargetDir:=Edit2.Text;
  SFileList:=TStringList.Create;
  Self.Caption:='正在准备复制... .. .';
  Application.ProcessMessages;
  GetFileList(SourceDir,SFileList); //获取所有文件列标
  TatolFilesStr:='该目录下共有文件：'
		    +IntToStr(SFileList.Count)+'个文件';
  Edit4.Text:=TatolFilesStr;   
  iLen:=Length(SourceDir);
  if SourceDir[iLen]='\' then
	tempStr1:=StrUtils.LeftStr(SourceDir,iLen-1) else
	   tempStr1:=SourceDir;
  tempStr2:=ExtractFileName(tempStr1);
  SourceDir:=ExtractFilePath(tempStr1);
  
  if DirectoryExists(TargetDir+tempStr2+'\') then
   if Application.MessageBox('目标目录已经存在，'+
	      #10#13+'如果选择确定则覆盖原目录下的所有文件！',				 
		'复制提示：',MB_OKCANCEL+MB_ICONSTOP)<>IDOK then
   begin
    SFileList.Free;
    exit;
   end;
   DelTheDir(TargetDir+tempStr2+'\'); //清空目录  
  Self.Caption:='开始复制... .. .';
  For i:=0 to SFileList.Count-1 do 
  begin
     ProgressBar1.Position:=0;
     Animate1.Active:=True;
     self.Caption:=SFileList[i];
     TargetFile:=TargetDir+StrUtils.RightStr(SFileList[i],
		  Length(SFileList[i])-Length(SourceDir));
     Edit2.Text:=ExtractFilePath(TargetFile);
     Edit3.Text:=ExtractFilePath(SFileList[i]);
     Edit4.Text:=TatolFilesStr+'--正在复制第'+IntToStr(i+1)+'个'+
                ',大小：'+IntToStr(FileSizeByName(SFileList[i]))+'字节';   
     if ForceDirectories(ExtractFilePath(TargetFile))=false then
     begin
       Application.MessageBox('目标目录创建失败！',				 
		'复制错误：',MB_OK+MB_ICONSTOP);
       SFileList.Free;
       exit;
       Animate1.Active:=False;
     end;         
     LFileCopy(SFileList[i],TargetFile);
     Edit1.Text:=ExtractFileName(SFileList[i]);
     if self.Tag=0 then
     begin
       Animate1.Active:=False;       
       Bitbtn1.Enabled:=True;
       SFileList.Free;
       exit;
     end;
  end;
  ProgressBar1.Position:=ProgressBar1.Max;
  SFileList.Free;
  Bitbtn3.Enabled:=False;
  BitBtn1.Enabled:=True;
  Self.Caption:='复制完毕';
  Animate1.Active:=False;
  if CheckBox1.Checked then close;  
end;

procedure TFDirCopyFm.BitBtn3Click(Sender: TObject);
begin
   Self.Tag:=1;//表示可以复制
   BitBtn3.Enabled:=False;
   DoDirCopy;
  
end;

procedure TFDirCopyFm.BitBtn1Click(Sender: TObject);
begin
  self.Tag:=0;
  close;
end;

procedure TFDirCopyFm.BitBtn2Click(Sender: TObject);
begin
   Self.Tag:=0;
   //tag=0 表示停止，1 表示开始
   BitBtn3.Caption:='开始复制';
   BitBtn3.Enabled:=True;
end;

procedure TFDirCopyFm.Edit4MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
   (Sender as TEdit).Hint:=(Sender as TEdit).Text;
end;

end.