Delphi 局域网点对点文件传输(IdTcpClient控件)

unit Unit1;

interface

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

type
TForm1 = class(TForm)
   Panel1: TPanel;
   Panel2: TPanel;
   SpeedButton1: TSpeedButton;
   SpeedButton2: TSpeedButton;
   SpeedButton3: TSpeedButton;
   LBFiles: TLabel;
   SpeedButton4: TSpeedButton;
   SpeedButton5: TSpeedButton;
   OpenDialog1: TOpenDialog;
   SaveDialog1: TSaveDialog;
   PB2: TProgressBar;
   PB1: TProgressBar;
   ListBox1: TListBox;
   Label2: TLabel;
   IdTCPClient1: TIdTCPClient;
   IdTCPServer1: TIdTCPServer;
   LBSend: TLabel;
   Edit1: TEdit;
   Label1: TLabel;
   IdTCPClient2: TIdTCPClient;
   IdTCPServer2: TIdTCPServer;
   procedure SpeedButton1Click(Sender: TObject);
   procedure ListBox1DblClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure SpeedButton2Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure SpeedButton4Click(Sender: TObject);
   procedure IdTCPServer1Execute(AThread: TIdPeerThread);
   procedure SpeedButton5Click(Sender: TObject);
   procedure SpeedButton3Click(Sender: TObject);
   procedure IdTCPServer2Connect(AThread: TIdPeerThread);
   procedure IdTCPServer2Execute(AThread: TIdPeerThread);
private
   { Private declarations }
public
   Function Act_DownFiles(CurFilePath,SerFilePath,CurFileName,SerFileName:String):Boolean;
end;

var
Form1: TForm1;
UserName:String;
RecivList:TStrings;
SendIP:String;
DownFlag:Boolean;
implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
   if ListBox1.Items.IndexOf(OpenDialog1.FileName) = -1 then
   begin
     ListBox1.Items.Add(OpenDialog1.FileName);
   end;
end;

end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
if ListBox1.ItemIndex >=0 then
   ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.Height:=267;
IdTCPServer2.Active:=True;
IdTCPServer1.Active:=True;
UserName:=’admin’;
RecivList:=TStringList.Create;
DownFlag:=True;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
TemFiles:String;
begin

if ListBox1.Count > 0 then
begin
   SpeedButton2.Enabled:=False;
  
   TemFiles:=ListBox1.Items.CommaText;

   IdTCPClient2.Host :=Trim(Edit1.Text);//服务器的地址

   if  IdTCPClient2.Connected then
     IdTCPClient2.Disconnect;

   Try
     IdTCPClient2.Connect;
   except
     MessageBox(Handle,’服务器没有开启’,’提示’,MB_OK);
     Exit;
   end;

   with   IdTCPClient2   do
   begin
     while   Connected   do
     begin
       try
         WriteLn(‘SendFiles#’+ListBox1.Items.CommaText+’%’+UserName); //指定路径
       finally
         Disconnect;//断开连接
       end;
     end;
   end;

end
else
begin
   MessageBox(Handle,’请选择要传送的文件’,’提示’,MB_OK);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
RecivList.Free;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
CurFilePath,SerFilePath:String;
FileName,TemStr:String;
i,TemInt:integer;
begin
SpeedButton4.Enabled:=False;

DownFlag:=True;
TemStr:=”;
TemInt:=0;

if SaveDialog1.Execute then
begin
   CurFilePath:=ExtractFilePath(SaveDialog1.FileName);

   for i:=0 to RecivList.Count – 1 do
   begin
     SerFilePath:=ExtractFilePath(RecivList.Strings[i]);
     FileName:=ExtractFileName(RecivList.Strings[i]);

     if not Act_DownFiles(CurFilePath,SerFilePath,FileName,FileName) then
     begin
       TemInt:=TemInt+1;
       TemStr:=TemStr+ FileName;
     end;
   end;

   if TemInt > 0 then
   begin
     MessageBox(Handle,PChar(TemStr+’文件没有传输成功’),’提示’,MB_OK);
   end
   else
   begin
     MessageBox(Handle,’所有文件传输成功’,’提示’,MB_OK);
   end;

   IdTCPClient1.Host :=SendIP;
  
   if  IdTCPClient1.Connected then
     IdTCPClient1.Disconnect;

   Try
     IdTCPClient1.Connect;
   except
     MessageBox(Handle,’服务器没有开启’,’提示’,MB_OK);
     Exit;
   end;

   with   IdTCPClient1   do
   begin
     while   Connected   do
     begin
       try
         WriteLn(‘OK’); //指定路径
       finally
         Disconnect;//断开连接
       end;
     end;
   end;

   Close;
end;
end;

Function TForm1.Act_DownFiles(CurFilePath,SerFilePath,CurFileName,SerFileName:String):Boolean;
var
TemFileName:String;
rbyte:array[0..4096] of byte;
sFile:TFileStream;
iFileSize:integer;
begin
PB1.Position:=0;
IdTCPClient1.Host :=SendIP;//服务器的地址

if  IdTCPClient1.Connected then
   IdTCPClient1.Disconnect;

Try
   IdTCPClient1.Connect;
except
   MessageBox(Handle,’服务器没有开启’,’提示’,MB_OK);
   Result:=False;
   Exit;
end;

with   IdTCPClient1   do
begin
   while   Connected   do
   begin
     try
       TemFileName:=SerFilePath+SerFileName;
       WriteLn(TemFileName); //指定路径

       if ReadLn<>’文件不存在’ then
       begin
         iFileSize:=IdTCPClient1.ReadInteger;
         PB1.Max :=  iFileSize div 100 ;
         sFile:=TFileStream.Create(CurFilePath+CurFileName,fmCreate);

         While iFileSize>4096 do
         begin
           if DownFlag then
           begin
             IdTCPClient1.ReadBuffer(rbyte,4096);// .ReadBuffer(rbyte,iLen);
             sFile.Write(rByte,4096);
             inc(iFileSize,-4096);
             PB1.Position:= PB1.Position +(4096 div 100) ;

             Application.ProcessMessages;
           end
           else
           begin
             Result:=False;
             Exit;
           end;
         end;

         IdTCPClient1.ReadBuffer(rbyte,iFileSize);// .ReadBuffer(rbyte,iLen);

         sFile.Write(rByte,iFileSize);
         sFile.Free;

         PB1.Position:=PB1.Max;
       end;

     finally
       Disconnect;//断开连接
     end;
   end;
end;
Result:=True;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
RecevFileName:string;
iFileHandle:integer;
iFileLen,cnt:integer;
buf:array[0..4096] of byte;
begin
if not AThread.Terminated and AThread.Connection.Connected then  //注意这里
begin
   with   AThread.Connection   do
   begin
     Try
       RecevFileName:=AThread.Connection.ReadLn;

       if RecevFileName=’OK’ then
       begin
         PB2.Position:=0;
         LBSend.Caption:=’All Files Send OK’;
       end;

       if RecevFileName=’RefusedAll’ then
       begin
         LBSend.Caption:=’All Files are Refused’;
         PB2.Position:=0;
       end;

       if (RecevFileName<>’OK’) and (RecevFileName<>’RefusedAll’) then
       begin
         if FileExists(RecevFileName) then
         begin
           PB2.Position:=0;

           WriteLn(RecevFileName);

           LBSend.Caption:=’Send: ‘+RecevFileName;

           iFileHandle:=FileOpen(RecevFileName,fmOpenRead); //得到此文件大小
           iFileLen:=FileSeek(iFileHandle,0,2);

           FileSeek(iFileHandle,0,0);
           AThread.Connection.WriteInteger(iFileLen,True);////hjh 20071009

           PB2.Max :=  iFileLen div 100 ;
        
           while iFileLen >0 do
           begin
             cnt:=FileRead(iFileHandle,buf,4096);
             AThread.Connection.WriteBuffer(buf,cnt,True);/////hjh20071009
             iFileLen:=iFileLen-cnt;
             PB2.Position:=PB2.Position +(4096 div 100) ;
             Application.ProcessMessages;
           end;

           FileClose(iFileHandle);
         end
         else
         begin
           WriteLn(‘文件不存在’);
         end;
       end;
     Finally
       Disconnect;//断开连接
     end;
   end;
end;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
i:integer;
begin
DownFlag:=False;

IdTCPClient1.Host :=SendIP;//服务器的地址

if  IdTCPClient1.Connected then
   IdTCPClient1.Disconnect;

Try
   IdTCPClient1.Connect;
except
   MessageBox(Handle,’服务器没有开启’,’提示’,MB_OK);
   Exit;
end;

with   IdTCPClient1   do
begin
   while   Connected   do
   begin
     try

       WriteLn(‘RefusedAll’); //指定路径

     finally
       Disconnect;//断开连接
     end;
   end;
end;

IdTCpClient1.Disconnect;

//Application.Terminate;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
TemStr:String;
begin
if Trim(LBSend.Caption)=” then
begin
   Close;
end;

if Trim(LBSend.Caption)=’All Files Send OK’ then
begin
   Close;
end
else
begin
   PB2.Position:=0;

   IdTCPClient2.Host :=Trim(Edit1.Text);//服务器的地址

   if  IdTCPClient2.Connected then
     IdTCPClient2.Disconnect;

   Try
     IdTCPClient2.Connect;
   except
     MessageBox(Handle,’服务器没有开启’,’提示’,MB_OK);
     Exit;
   end;

   with   IdTCPClient2   do
   begin
     while   Connected   do
     begin
       try
         WriteLn(‘RefuseSend’); //指定路径

       finally
         Disconnect;//断开连接
       end;
     end;
   end;
  
end;

end;

procedure TForm1.IdTCPServer2Connect(AThread: TIdPeerThread);
begin
SendIP:=AThread.Connection.Socket.Binding.PeerIP;

end;

procedure TForm1.IdTCPServer2Execute(AThread: TIdPeerThread);
var
RecivStr,FileStr:String;
TemList:TStrings;
TemUser:String;
i:integer;
begin
if not AThread.Terminated and AThread.Connection.Connected then  //注意这里
begin
   with   AThread.Connection   do
   begin
     Try

       FileStr:=”;
       RecivStr:=ReadLn;

       if RecivStr <>’RefuseSend’ then
       begin
         if Pos(‘SendFiles’,RecivStr) > 0 then
         begin
           Self.Height:=130;
           Panel1.Visible:=False;
           RecivList.Clear;

           RecivList.CommaText:=Copy(RecivStr,Pos(‘#’,RecivStr)+1,Pos(‘%’,RecivStr)-Pos(‘#’,RecivStr)-1);
           TemUser:=Copy(RecivStr,Pos(‘%’,RecivStr)+1,Length(RecivStr)-Pos(‘%’,RecivStr));

           for i:=0 to RecivList.Count -1 do
           begin
             FileStr:=FileStr+ExtractFileName(RecivList.Strings[i])+’,’;
           end;

           LBFiles.Caption:=TemUser+’ 向您发送文件:’+FileStr+’请接收’;
         end;
       end;

       if RecivStr=’RefuseSend’ then
       begin
         LBFiles.Caption:=’对方取消了发送文件’;
         PB1.Position:=0;
         DownFlag:=False;
       end;

     Finally
       Disconnect;
     end;
   end;
end;

end;

end.