remotedirdlunit.~pas

DELPHI 下远程控制源码

unit RemoteDirDLUnit;

interface

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

type
  TRemoteDirDLFm = class(TForm)
    Label4: TLabel;
    Label1: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    Edit2: TEdit;
    Edit4: TEdit;
    Edit1: TEdit;
    Animate1: TAnimate;
    ProgressBar1: TProgressBar;
    Panel1: TPanel;
    BitBtn3: TBitBtn;
    BitBtn1: TBitBtn;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    DownLoadTcp: TIdTCPClient;
    procedure BitBtn3Click(Sender: TObject);
    procedure DownLoadTcpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure DownLoadTcpWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  RemoteDirDLFm: TRemoteDirDLFm;

implementation

uses Unit1,Unit1UseUnit;

{$R *.dfm}

procedure TRemoteDirDLFm.BitBtn3Click(Sender: TObject);
var
  iReturn,i       :integer;
  ReadLen         :integer;//read Stream Length
  TheFileList     :TStringlist; //change to File list
  ReadFListStream :TStringStream; //read remote filelist stream
  DownLoadFile    :String;
  RFStream        :TFileStream;//read single file Stream
  DowntoTheDir    :String;//下载到这个目录
  FromDir         :String;//下载的远程目录
  NewSubDir       :String;//提取新的目录，便于创建
  TheRootDir      :String;//子目录所在的目录
  TempStr         :String;//临时的字符串
  SaveToTheFile   :String;//保存到该文件
begin
  Self.Tag:=1;
  Bitbtn3.Enabled:=False;
  FromDir:=Edit3.Text;
  DownToTheDir:=Edit2.Text;

  if FromDir[Length(FromDir)]='\' then
     TempStr:=StrUtils.LeftStr(FromDir,Length(FromDir)-1) else
     TempStr:=FromDir;
  NewSubDir:=ExtractFileName(TempStr);//提取新的子目录名
  TheRootDir:=ExtractFilePath(TempStr);
  if DirectoryExists(DownToTheDir+NewSubDir+'\') then
     if Application.MessageBox('=====目标目录已经存在!====='+
	      #10#13+'如果选择确定则覆盖原目录下的所有文件！',				 
		'移动提示：',MB_OKCANCEL+MB_ICONSTOP)<>IDOK then exit; 
		  
  if Form1.ConnectRemoteHost(DownLoadTcp,Form1.TheFileConnectRec) then
  begin //============================================================ 
     Animate1.Active:=True;                                 // 还是网络的原因
     Bitbtn1.Enabled:=False;
     try
       iReturn:=DownLoadTcp.ReadInteger;//读取连接后反馈的信息,表示是验证的原因     
       DownLoadTcp.Write('目录下载'+EOL);    //1-SendfileCMD         // 还是网络的原因 
       DownLoadTcp.Write(Edit3.Text+EOL);    //2-Send The Directory name 
     except
       self.Caption:='网络传输失败！';
       beep;
       Animate1.Active:=False;                                
       Bitbtn1.Enabled:=True;
       exit;
     end;
     
     TheFilelist:=TStringList.Create;
     ReadFListStream:=TStringStream.Create(''); 
     
     try     
       ReadLen:=DownLoadTcp.ReadInteger; //读取流长度
       DownLoadTcp.ReadStream(ReadFListStream,ReadLen,false); //读取文件列表流
     except
       self.Caption:='网络传输失败！';
       beep;
       TheFileList.Free;
       ReadFListStream.Free;
       Animate1.Active:=False;                    
       Bitbtn1.Enabled:=True;
       exit;
     end;
       ReadFListStream.position:=0;
       TheFileList.LoadFromStream(ReadFListStream);//转化成文件列表
     
     DelTheDir(DownToTheDir+NewSubDir+'\'); //清空目录 
     
     For i:=0 to TheFileList.Count-1 do
     begin
	if self.Tag=0 then//查看停止标志 
	begin 
	   DownLoadTcp.write('可以断开了'+EOL);
	   DownLoadTcp.Disconnect;
	   TheFilelist.Free;
	   ReadFListStream.Free; 	   
	   beep;
	   Bitbtn1.Enabled:=True;
	   Animate1.Active:=False;
	   exit;	   
	end;
	DownLoadFile:=TheFileList[i];
	try
	  DownLoadTcp.write('文件连续申请'+EOL);
	  DownLoadTcp.Write(DownLoadFile+EOL);
	  ReadLen:=DownLoadTcp.ReadInteger;
		
	  Edit1.Text:=ExtractFileName(DownLoadFile)+' ,大小：'+IntToStr(ReadLen)+'字节';
	  Edit4.Text:='该目录下共有文件：'+IntToStr(TheFileList.Count)+'个，'+
		       '正在传输第'+IntToStr(i+1)+'个';
	  Edit3.Text:=ExtractFilePath(DownLOadFile); 		
	  SaveToTheFile:=DownToTheDir+'\'+StrUtils.RightStr(DownLoadFile,
		  Length(DownLoadFile)-Length(TheRootDir));  //合成新文件名
	  Edit2.Text:=ExtractFilePath(SaveToTheFile); //显示复制到该目录下
	//-----创建目录	
	  if ForceDirectories(ExtractFilePath(SaveToTheFile))=false then
	      if Application.MessageBox('目标目录创建失败！',				 
		       '复制错误：',MB_OKCANCEL+MB_ICONSTOP)<>IDOK Then
	   begin 
	     self.Caption:='已经取消了后续的操作！';
	     beep;
	     TheFileList.Free;
	     ReadFListStream.Free;
	     Animate1.Active:=False;                    
	     Bitbtn1.Enabled:=True;
	     exit;   
	   end;
	//下载并写到该文件   
	  RFStream:=TFileStream.Create(SaveToTheFile,fmCreate);
	  DownLoadTcp.ReadStream(RFStream,ReadLen,false); //下载到该文件流
          RFStream.Free;  
       except
	 self.Caption:='网络传输失败！';
	 beep;
	 RFStream.Free;
	 TheFileList.Free;
	 ReadFListStream.Free;
	 Animate1.Active:=False;                    
	 Bitbtn1.Enabled:=True;
	 exit;
       end;  	
     end; //传输完毕=====================================
     try
       DownLoadTcp.write('可以断开了'+EOL);
     except
     end;
     beep;
     Bitbtn1.Enabled:=True;
     Animate1.Active:=False;
     TheFilelist.Free;
     ReadFListStream.Free; 
  end;
	 
end;

procedure TRemoteDirDLFm.DownLoadTcpWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
   ProgressBar1.Position:=0;
   ProgressBar1.Max:=AWorkCountMax;
end;

procedure TRemoteDirDLFm.DownLoadTcpWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
var
   iPos:int64;
begin
   ProgressBar1.Position:=AWorkCount;
   iPos:=AWorkCount;
   Self.Caption:='正在下载文件：'+
                IntToStr(iPos*100 div ProgressBar1.Max)+'%';
end;

procedure TRemoteDirDLFm.BitBtn2Click(Sender: TObject);
begin
  Self.Tag:=0;
  DownLoadTcp.Disconnect;
end;

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

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

end.