searchdlunit.pas

DELPHI 下远程控制源码

unit SearchDLUnit;

interface

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

type
  TSearchDLFm = class(TForm)
    Edit2: TEdit;
    Edit1: TEdit;
    Animate1: TAnimate;
    DownLoadTcp: TIdTCPClient;
    SaveDialog1: TSaveDialog;
    Label5: TLabel;
    Label6: TLabel;
    ProgressBar1: TProgressBar;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Bevel1: TBevel;
    BitBtn4: TBitBtn;
    CheckBox2: TCheckBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DownLoadTcpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure DownLoadTcpWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    SavePath  :String;          //下载到此目录下
    SearchList:TStringList;     //下载的文件列表
  end;

var
  SearchDLFm: TSearchDLFm;

implementation

uses Unit1;

{$R *.dfm}

procedure TSearchDLFm.BitBtn1Click(Sender: TObject);
var
  iRet,i:integer;
  ReadRet:string;
  SaveFStream:TFileStream;
  TheFileName:String;
  TheFileSize:integer;
begin
  if Form1.ConnectRemoteHost(DownLoadTcp,Form1.TheFileConnectRec) then
  begin //============================================================ 
    Try     
      iRet:=DownLoadTcp.ReadInteger;       //读取额外标志
    except
      Animate1.Active:=False;
      Self.Caption:='网络中断';
      exit;
    end;
     Animate1.Active:=DownLoadTcp.Connected;
   
    For i:=0 to SearchList.Count-1 do    //循环下载
    begin
       Self.Caption:='正在下载第'+IntToStr(i+1)+'个，总共有'
			   +IntToStr(SearchList.Count)+'个文件';
			   
       Self.Edit1.Text:=SavePath+ExtractFileName(SearchList[i]);
       Self.Edit2.Text:=SearchList[i];
       
       TheFileName:=SavePath+ExtractFileName(SearchList[i]);
       if FileExists(TheFileName) then 
       begin
	  //重命名过程
	  if CheckBox2.Checked=False then
	  begin
	    SaveDialog1.Title:='文件名冲突，请重新命名文件名';
	    SaveDialog1.FileName:=TheFileName+IntToStr(i);
	    if SaveDialog1.Execute then
	       TheFileName:=SaveDialog1.FileName else
	       TheFileName:=TheFileName+'New'+IntToStr(i);
	  end else TheFileName:=TheFileName+'New'+IntToStr(i);
       end; 
      try
       DownLoadTcp.Write('搜索下载'+EOL);       //1-------SendfileCMD
       DownLoadTcp.Write(SearchList[i]+EOL);    //2-------SendfileName       
       ReadRet:=DownLoadTcp.ReadLn(EOL);
      except
	Animate1.Active:=False;
	Self.Caption:='网络中断';
	exit;
      end;       //1==读接收标志
       if ReadRet='OK' then                     //2==开始接收处理
       begin
	 try
	  SaveFStream:=TFileStream.Create(TheFileName,fmCreate); //创建文件
	 except
	   Animate1.Active:=False;
	   Self.Caption:='文件创建错误，导致下载终止！';
	   exit;
	 end;  
	 try
	  TheFileSize:=DownLoadTcp.ReadInteger;  //读取文件长度
	  DownLoadTcp.ReadStream(SaveFStream,TheFileSize); //读取文件流
	 except
	   Animate1.Active:=False;
	   Self.Caption:='文件传输中断';
	   SaveFStream.Free;
	   exit;
	 end;
	  SaveFStream.Free;
       end else//该文件不寸在： ReadRet<>OK
       begin  end;
      
     end;
    try
     DownLoadTcp.Write('去去去.去去去'+EOL);
     DownLoadTcp.Disconnect;
    except
      Self.Caption:='结束错误';
      exit;
    end;
  end;//连接后的操作
  Self.Caption:='总共有'+IntToStr(SearchList.Count)+
					   '个文件，已经完全下载完毕！';
  Animate1.Active:=DownLoadTcp.Connected;
  if CheckBox1.Checked then Close;
end;

procedure TSearchDLFm.FormCreate(Sender: TObject);
begin
  SearchList:=TStringList.Create;
end;

procedure TSearchDLFm.FormDestroy(Sender: TObject);
begin
   SearchList.Free;
end;

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

procedure TSearchDLFm.DownLoadTcpWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
   ProgressBar1.Position:=AWorkCount;
end;

procedure TSearchDLFm.BitBtn4Click(Sender: TObject);
begin
   DownLoadTcp.Disconnect;
end;

procedure TSearchDLFm.BitBtn2Click(Sender: TObject);
begin
   if not DownLoadTcp.Connected then close;
end;

end.