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

unit Unit1;interfaceuses
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) = - then
begin
ListBox1.Items.Add(OpenDialog1.FileName);
end;
end;end;procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
if ListBox1.ItemIndex >= then
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
self.Height:=;
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 > 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:=; if SaveDialog1.Execute then
begin
CurFilePath:=ExtractFilePath(SaveDialog1.FileName); for i:= to RecivList.Count - do
begin
SerFilePath:=ExtractFilePath(RecivList.Strings[i]);
FileName:=ExtractFileName(RecivList.Strings[i]); if not Act_DownFiles(CurFilePath,SerFilePath,FileName,FileName) then
begin
TemInt:=TemInt+;
TemStr:=TemStr+ FileName;
end;
end; if TemInt > 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[..] of byte;
sFile:TFileStream;
iFileSize:integer;
begin
PB1.Position:=;
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 ;
sFile:=TFileStream.Create(CurFilePath+CurFileName,fmCreate); While iFileSize> do
begin
if DownFlag then
begin
IdTCPClient1.ReadBuffer(rbyte,);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,);
inc(iFileSize,-);
PB1.Position:= PB1.Position +( div ) ; 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[..] 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:=;
LBSend.Caption:='All Files Send OK';
end; if RecevFileName='RefusedAll' then
begin
LBSend.Caption:='All Files are Refused';
PB2.Position:=;
end; if (RecevFileName<>'OK') and (RecevFileName<>'RefusedAll') then
begin
if FileExists(RecevFileName) then
begin
PB2.Position:=; WriteLn(RecevFileName); LBSend.Caption:='Send: '+RecevFileName; iFileHandle:=FileOpen(RecevFileName,fmOpenRead); //得到此文件大小
iFileLen:=FileSeek(iFileHandle,,); FileSeek(iFileHandle,,);
AThread.Connection.WriteInteger(iFileLen,True);////hjh PB2.Max := iFileLen div ; while iFileLen > do
begin
cnt:=FileRead(iFileHandle,buf,);
AThread.Connection.WriteBuffer(buf,cnt,True);/////hjh20071009
iFileLen:=iFileLen-cnt;
PB2.Position:=PB2.Position +( div ) ;
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:=; 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) > then
begin
Self.Height:=;
Panel1.Visible:=False;
RecivList.Clear; RecivList.CommaText:=Copy(RecivStr,Pos('#',RecivStr)+,Pos('%',RecivStr)-Pos('#',RecivStr)-);
TemUser:=Copy(RecivStr,Pos('%',RecivStr)+,Length(RecivStr)-Pos('%',RecivStr)); for i:= to RecivList.Count - do
begin
FileStr:=FileStr+ExtractFileName(RecivList.Strings[i])+',';
end; LBFiles.Caption:=TemUser+' 向您发送文件:'+FileStr+'请接收';
end;
end; if RecivStr='RefuseSend' then
begin
LBFiles.Caption:='对方取消了发送文件';
PB1.Position:=;
DownFlag:=False;
end; Finally
Disconnect;
end;
end;
end;end;end.