您的位置：首页 > 理论基础 > 计算机网络

（死亡历险）Delphi7 IdTCPClient1，IdTCPServer1客户端向服务端传送大型文件

2016-12-26 02:16 465 查看

服务端
unit Unit1;

interface

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

type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
host: TEdit;
port: TEdit;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
SaveDialog1: TSaveDialog;
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
rbyte:array[0..4096] of byte;
sFile:TFileStream;
//cnt:integer;
cmd,FileSize:integer;
str,FileName:string;
begin
if not AThread.Terminated and AThread.Connection.Connected then //注意这里
begin
with AThread.Connection do
begin
Try
str:=AThread.Connection.ReadLn; //接收文件大小及文件名
cmd:=pos('|',str); //查找分隔符
FileName:=copy(str,1,cmd-1); //提取文件名
FileSize:=StrToInt(copy(str,cmd+1,Length(str)-cmd+1)); //提取文件大小
//if MessageBox(0,Pchar('用户'+AThread.Connection.Socket.Binding.PeerIP+'要给您传送文件 "'+FileName+'" 您是接受还是拒绝?'),'文件接受',MB_YesNo or MB_ICONQUESTION)=ID_Yes then //询问是否接收
//begin
//ProgressBar1.Max:=FileSize; //初始化进度条
//ProgressBar1.Position:=0;
//SaveDialog1.FileName:=FileName; //指定保存的默认文件名,一定要在 SaveDialog1.Execute;之前,不然文件名为空
//SaveDialog1.Execute;
//sFile:=TFileStream.Create(SaveDialog1.FileName,fmCreate); //创建待写入的文件流
sFile:=TFileStream.Create(ExtractFilePath(ParamStr(0))+'\'+FileName,fmCreate);
While FileSize>4096 do
begin
Application.ProcessMessages;
AThread.Connection.ReadBuffer(rbyte,4096);// 读取文件流
sFile.Write(rByte,4096); //写入文件流
//cnt:=AThread.Connection.ReadInteger; //从发送端接收最新的进度位置信息
//ProgressBar1.Position:=ProgressBar1.Position+cnt; //更新显示进度
//StatusBar1.Panels[0].Text:='正在接收文件中...';
Memo1.Lines.Add('正在接收文件中...'+DateTimeToStr(Now));
inc(FileSize,-4096);
end;
AThread.Connection.ReadBuffer(rbyte,FileSize);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,FileSize);
sFile.Free;
Memo1.Lines.Add('文件接收完成!'+DateTimeToStr(Now));
//end;
Finally
//Disconnect;//断开连接
end;
end;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.Bindings.Add.IP:=host.Text;//'192.168.252.1';
IdTCPServer1.Bindings.Add.Port:=StrToInt(port.Text);//8830;
IdTCPServer1.Active:=true;
if IdTCPServer1.Active then
begin
Memo1.Lines.Add('Server running');
end
else
begin
Memo1.Lines.Add('Server stop');
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
IdTCPServer1.Destroy;
Memo1.Lines.Add('Server stop');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SpeedButton1Click(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
IdTCPServer1.Active:=False;
Application.Terminate;
end;

end.
-----------------------------------------------------

客户端

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
SpeedButton2: TSpeedButton;
SpeedButton1: TSpeedButton;
host: TEdit;
port: TEdit;
Memo1: TMemo;
edtFileName: TEdit;
IdTCPClient1: TIdTCPClient;
OpenDialog1: TOpenDialog;
SpeedButton3: TSpeedButton;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SpeedButton3Click(Sender);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
OpenDialog1.Execute;
edtFileName.Text:=OpenDialog1.FileName;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
iFileHandle:integer;
iFileLen,cnt:integer;
buf:array[0..4096] of byte;
begin
iFileHandle:=FileOpen(edtFileName.Text,fmOpenRead);
iFileLen:=FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
ProgressBar1.Max:=iFileLen;
ProgressBar1.Position := 0;
IdTCPClient1.WriteLn(ExtractFileName(edtFileName.Text)+'|'+IntToStr(iFileLen));
while true do
begin
Application.ProcessMessages;
cnt:=FileRead(iFileHandle,buf,4096);
IdTCPClient1.WriteBuffer(buf,cnt);
//IdTCPClient1.WriteInteger(cnt);
ProgressBar1.Position:=ProgressBar1.Position + cnt;
Memo1.Lines.Add('正在传送文件...'+DateTimeToStr(Now));
if cnt<4096 then
break;
end;
FileClose(iFileHandle);
Memo1.Lines.Add('文件传送完成!'+DateTimeToStr(Now));

SpeedButton3Click(Sender);
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Add('已连接');
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
IdTCPClient1.Host:=host.Text;//'192.168.252.1';
IdTCPClient1.Port:=StrToInt(port.Text);//8829;

if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;

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

end.

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签：

相关文章推荐

新的分享

章节导航