fdirxcopyunit.pas

DELPHI 下远程控制源码

unit FDirXCopyUnit;

interface

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

type
  TFDirXCopyFm = class(TForm)
    Panel1: TPanel;
    BitBtn3: TBitBtn;
    BitBtn1: TBitBtn;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    Edit3: TEdit;
    Label6: TLabel;
    Label5: TLabel;
    Edit2: TEdit;
    Label1: TLabel;
    Edit4: TEdit;
    Label4: TLabel;
    Edit1: TEdit;
    Animate1: TAnimate;
    ProgressBar1: TProgressBar;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    procedure LFileCopy(SF,DF:String); //单文件复制
    procedure DoDirCopy;               //目录复制
  public
    { Public declarations }
  end;

var
  FDirXCopyFm: TFDirXCopyFm;

implementation

{$R *.dfm}

uses Unit1UseUnit;

procedure TFDirXCopyFm.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 TFDirXCopyFm.DoDirCopy;
var
  SFileList           :TStringList;   
  SourceDir,TargetDir,SRootDir :String;  
  TargetFile          :String;
  i,iLen              :integer;
  tempStr1,tempStr2   :String;
  TatolFilesStr       :String;  
begin
  SRootDir:=Edit3.Text;
  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:=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;
     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;
  if DelTheDir(SRootDir)=true then  
     Self.Caption:='移动完毕' else
     begin
       beep;
       Self.Caption:='复制完毕后，原目录删除失败！';
       Animate1.Active:=False;
       exit;
     end;
  Animate1.Active:=False;
  if CheckBox1.Checked then close;  
end;
procedure TFDirXCopyFm.BitBtn3Click(Sender: TObject);
begin
   Self.Tag:=1;//表示可以复制
   BitBtn3.Enabled:=False;
   DoDirCopy;
end;

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

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

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

end.