捐献所有分 求简单的文件传输程序 例子 急!好心人帮忙啊! 捐献所有分 求简单的文件传输程序 要求是delphi 5做的 没办法 我现在要改个业务只能是这个版本,好心人帮忙啊!急需 谢谢! 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 http://www.codepub.com/Software/view-software-5277.html到这里看看吧 看看文件流的操作,分段发送,再合并流就行了,如果搞不定,把你邮件告诉我,我给你发个例子,把你邮箱地址发到[email protected] http://www.delphifans.com/SoftView/SoftView_836.html就是这个了,indy写的 unit U_Client;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, Math, StdCtrls, ComCtrls;type Tfrm_Client = class(TForm) SaveDialog1: TSaveDialog; IdTCPClient1: TIdTCPClient; Button1: TButton; StatusBar1: TStatusBar; Edit1: TEdit; Label1: TLabel; Edit2: TEdit; Label2: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var frm_Client: Tfrm_Client;implementation{$R *.dfm}procedure Tfrm_Client.Button1Click(Sender: TObject);var cmd: string; ASize, TotalSize: Int64; AFileStream: TFileStream;begin IdTCPClient1.Host := Edit1.Text; //连接主机 IdTCPClient1.Port := StrToIntDef(Edit2.Text, 9925); //端口 IdTCPClient1.Connect; //连接 try IdTCPClient1.WriteLn('BEGIN'); //提示服务器开始接收 cmd := IdTCPClient1.ReadLn; //以“|”符号分离文件名 SaveDialog1.FileName := Copy(cmd, Pos('|', cmd) + 1, Length(cmd)); if not SaveDialog1.Execute then begin IdTCPClient1.WriteLn('CANCEL'); //告诉服务器取消 IdTCPClient1.Disconnect; //断开连接 exit; end; TotalSize := StrToInt(Copy(cmd, 0, Pos('|', cmd) - 1)); //分离文件大小 //建立文件流准备接收 AFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate); try //循环开始接受 repeat IdTCPClient1.WriteLn(IntToStr(AFileStream.Size));//发送当前传输的位置 ASize := Min(TotalSize - AFileStream.Size, IdTCPClient1.RecvBufferSize); //选择剩余大小和缓冲区大小小的一个作为传输的大小 IdTCPClient1.ReadStream(AFileStream, ASize); //接收流 StatusBar1.SimpleText := Format('当前传输位置%d/大小%d', [AFileStream.Size, TotalSize]); Application.ProcessMessages; until AFileStream.Size = TotalSize; //大小一致了表示结束 finally AFileStream.Free; //释放文件流 end; IdTCPClient1.WriteLn('END'); //提示服务器传输完成 StatusBar1.SimpleText := '传输完成...'; except StatusBar1.SimpleText := '连接服务器失败或者对方已经中断传输!'; end; IdTCPClient1.Disconnect;end;end. unit U_Server;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;type Tfrm_Server = class(TForm) IdTCPServer1: TIdTCPServer; Button1: TButton; Button2: TButton; Button3: TButton; ProgressBar1: TProgressBar; StatusBar1: TStatusBar; Edit1: TEdit; Button4: TButton; OpenDialog1: TOpenDialog; Edit2: TEdit; Label1: TLabel; Label2: TLabel; procedure Button1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure IdTCPServer1Execute(AThread: TIdPeerThread); procedure FormClose(Sender: TObject; var Action: TCloseAction); private AFileStream: TFileStream; //传输的文件流 procedure ButtonBegin; procedure ButtonEnd; { Private declarations } public { Public declarations } end;var frm_Server: Tfrm_Server;implementation{$R *.dfm}procedure Tfrm_Server.Button1Click(Sender: TObject);begin if OpenDialog1.Execute then Edit1.Text := OpenDialog1.FileName;end;procedure Tfrm_Server.Button4Click(Sender: TObject);begin Close;end;procedure Tfrm_Server.Button2Click(Sender: TObject);begin if not FileExists(Edit1.Text) then //检测文件是否存在 begin Showmessage('文件不存在,请选择文件!'); exit; end; //建立文件流 AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead); ProgressBar1.Max := AFileStream.Size; ProgressBar1.Position := 0; ButtonBegin; //VCL开始状态设置 //服务器准备好连接 IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925); if not IdTCPServer1.Active then IdTCPServer1.Active := True;end;procedure Tfrm_Server.ButtonBegin;begin //VCL开始状态设置 Button1.Enabled := False; Button2.Enabled := False; Button3.Enabled := True; Button4.Enabled := False;end;procedure Tfrm_Server.ButtonEnd;begin //VCL结束状态设置 Button1.Enabled := True; Button2.Enabled := True; Button3.Enabled := False; Button4.Enabled := True;end;procedure Tfrm_Server.Button3Click(Sender: TObject);begin StatusBar1.SimpleText := '传输取消...'; AFileStream.Free; //释放文件流 ButtonEnd; //VCL结束状态设置end;procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);var cmd: string; //接收到客户端的字符串信息 ASize: Integer; //需要传输的流大小begin with AThread.Connection do //已经连街上的一个进程 begin cmd := UpperCase(ReadLn); //客户端发送的命令字符串 if cmd = 'BEGIN' then //开始传输 begin //告诉远程传输文件的大小和文件名 WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)])); StatusBar1.SimpleText := '准备传输...'; Exit; end; if cmd = 'END' then begin //传输完成 Button3.Click; StatusBar1.SimpleText := '传输完成...'; Exit; end; if cmd = 'CANCEL' then begin //传输取消 StatusBar1.SimpleText := '传输取消...'; //保持传输状态 Exit; end; //按照指定位置传输文件 AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置 ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize); //计算需要发送的大小,Min()函数在Math单元 OpenWriteBuffer; //准备发送缓冲 WriteStream(AFileStream, false, false, ASize); //注意这个函数的参数。 CloseWriteBuffer; //结束发送缓冲 StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]); ProgressBar1.Position := ProgressBar1.Position + ASize; end;end;procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);begin IdTCPServer1.Active := False;end;end. 你需要下载一个indy9,然后选择d5的安装包安装到你得ide中,然后设置Delphi Search Path Delphi园地里面有这方面的源代码,自己去找一下吧 unit U_Server;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;type Tfrm_Server = class(TForm) IdTCPServer1: TIdTCPServer; Button1: TButton; Button2: TButton; Button3: TButton; ProgressBar1: TProgressBar; StatusBar1: TStatusBar; Edit1: TEdit; Button4: TButton; OpenDialog1: TOpenDialog; Edit2: TEdit; Label1: TLabel; Label2: TLabel; procedure Button1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure IdTCPServer1Execute(AThread: TIdPeerThread); procedure FormClose(Sender: TObject; var Action: TCloseAction); private AFileStream: TFileStream; //传输的文件流 procedure ButtonBegin; procedure ButtonEnd; { Private declarations } public { Public declarations } end;var frm_Server: Tfrm_Server;implementation{$R *.dfm}procedure Tfrm_Server.Button1Click(Sender: TObject);begin if OpenDialog1.Execute then Edit1.Text := OpenDialog1.FileName;end;procedure Tfrm_Server.Button4Click(Sender: TObject);begin Close;end;procedure Tfrm_Server.Button2Click(Sender: TObject);begin if not FileExists(Edit1.Text) then //检测文件是否存在 begin Showmessage('文件不存在,请选择文件!'); exit; end; //建立文件流 AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead); ProgressBar1.Max := AFileStream.Size; ProgressBar1.Position := 0; ButtonBegin; //VCL开始状态设置 //服务器准备好连接 IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925); if not IdTCPServer1.Active then IdTCPServer1.Active := True;end;procedure Tfrm_Server.ButtonBegin;begin //VCL开始状态设置 Button1.Enabled := False; Button2.Enabled := False; Button3.Enabled := True; Button4.Enabled := False;end;procedure Tfrm_Server.ButtonEnd;begin //VCL结束状态设置 Button1.Enabled := True; Button2.Enabled := True; Button3.Enabled := False; Button4.Enabled := True;end;procedure Tfrm_Server.Button3Click(Sender: TObject);begin StatusBar1.SimpleText := '传输取消...'; AFileStream.Free; //释放文件流 ButtonEnd; //VCL结束状态设置end;procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);var cmd: string; //接收到客户端的字符串信息 ASize: Integer; //需要传输的流大小begin with AThread.Connection do //已经连街上的一个进程 begin cmd := UpperCase(ReadLn); //客户端发送的命令字符串 if cmd = 'BEGIN' then //开始传输 begin //告诉远程传输文件的大小和文件名 WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)])); StatusBar1.SimpleText := '准备传输...'; Exit; end; if cmd = 'END' then begin //传输完成 Button3.Click; StatusBar1.SimpleText := '传输完成...'; Exit; end; if cmd = 'CANCEL' then begin //传输取消 StatusBar1.SimpleText := '传输取消...'; //保持传输状态 Exit; end; //按照指定位置传输文件 AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置 ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize); //计算需要发送的大小,Min()函数在Math单元 OpenWriteBuffer; //准备发送缓冲 WriteStream(AFileStream, false, false, ASize); //注意这个函数的参数。 CloseWriteBuffer; //结束发送缓冲 StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]); ProgressBar1.Position := ProgressBar1.Position + ASize; end;end;procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);begin IdTCPServer1.Active := False;end;end. 改了下Indy的demo。最简单的实现Client Code:procedure TForm2.Button1Click(Sender: TObject);const c_PackLen = $1000; //1Kvar SResponse : String; fStream : TFileStream; dcStream : TDecompressionStream; fSize : Integer; iRcvLen : Integer;begin with TCPClient do begin Connect; while Connected do begin fStream := TFileStream.Create(FileName, fmCreate or fmOpenWrite); try //Decompression dcStream := TDecompressionStream.Create(fStream); try // banner means the server thread is running SResponse := UpperCase(ReadLn); if Pos('BEG', SResponse) = 0 then Break; fSize := StrToInt(Copy(SResponse, 4, Length(SResponse) - 3)); //Progress pbDown.Max := fSize; pbDown.Postion := 0; repeat // request file data WriteLn('SENDFILE'); { read all bytes until disconnected length er in stream } iRcvLen := ReadInteger(); ReadStream(dcStream, iRcvLen, True); pbDown.Postion := pbDown.Postion + iRcvLen; until iRcvLen < c_PackLen; finally dcStream.Free; end; finally Disconnect; fStream.Free; end; end; end;end;Server Code:procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);const c_PackLen = $1000; //1Kvar fStream : TFileStream; cStream : TCompressionStream; iSendLen: Integer;begin with AThread.Connection do begin fStream := TFileStream(FileName, fmOpenRead or fmShareDenyNone); try //Compression cStream := TCompressionStream.Create(clFastest, fStream); try WriteLn('BEG' + IntToStr(fStream.Size)); repeat iSendLen := Min(c_PackLen, fStream.Size - fStream.Postion); OpenWriteBuffer; try WriteStream(cStream, False, True, iSendLen); finally CloseWriteBuffer; end; until iSendLen < c_PackLen; finally cStream.Free; end; finally Disconnect; fStream.free; end; end;end; 呵呵 我的是delphi 5的版本 你们说的都是用了TIdTCPClient 和TIdTCPServer控件 d5里面没有的 .不过还是谢谢各位了.有意的加我QQ 365824476 长期学习交流. 请问如何实现我这种进销存的业务 DBGRID问题 问一个字符串变换问题~ 一个关于savedialog的小问题,请高手指导 关于VCL的问题? dbgrid格式问题(在线等待中…………………………) 修改表中数据出现“缺少更新或刷新的键列信息” 你知道吗? JPG图片如何实现特效显示 我的运用程序怎么不能运行? 如果同一个产品编号下面有不同批次的产品,出库的时候必须考虑是相同批次的产品 才能出库,如何体现这点 求职:delphi,散分,找到工作再加分
到这里看看吧
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, Math,
StdCtrls, ComCtrls;type
Tfrm_Client = class(TForm)
SaveDialog1: TSaveDialog;
IdTCPClient1: TIdTCPClient;
Button1: TButton;
StatusBar1: TStatusBar;
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
frm_Client: Tfrm_Client;implementation{$R *.dfm}procedure Tfrm_Client.Button1Click(Sender: TObject);
var
cmd: string;
ASize, TotalSize: Int64;
AFileStream: TFileStream;
begin
IdTCPClient1.Host := Edit1.Text; //连接主机
IdTCPClient1.Port := StrToIntDef(Edit2.Text, 9925); //端口
IdTCPClient1.Connect; //连接
try
IdTCPClient1.WriteLn('BEGIN'); //提示服务器开始接收
cmd := IdTCPClient1.ReadLn;
//以“|”符号分离文件名
SaveDialog1.FileName := Copy(cmd, Pos('|', cmd) + 1, Length(cmd));
if not SaveDialog1.Execute then
begin
IdTCPClient1.WriteLn('CANCEL'); //告诉服务器取消
IdTCPClient1.Disconnect; //断开连接
exit;
end;
TotalSize := StrToInt(Copy(cmd, 0, Pos('|', cmd) - 1)); //分离文件大小
//建立文件流准备接收
AFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
try //循环开始接受
repeat
IdTCPClient1.WriteLn(IntToStr(AFileStream.Size));//发送当前传输的位置
ASize := Min(TotalSize - AFileStream.Size, IdTCPClient1.RecvBufferSize);
//选择剩余大小和缓冲区大小小的一个作为传输的大小
IdTCPClient1.ReadStream(AFileStream, ASize); //接收流
StatusBar1.SimpleText := Format('当前传输位置%d/大小%d', [AFileStream.Size, TotalSize]);
Application.ProcessMessages;
until AFileStream.Size = TotalSize; //大小一致了表示结束
finally
AFileStream.Free; //释放文件流
end;
IdTCPClient1.WriteLn('END'); //提示服务器传输完成
StatusBar1.SimpleText := '传输完成...';
except
StatusBar1.SimpleText := '连接服务器失败或者对方已经中断传输!';
end;
IdTCPClient1.Disconnect;
end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;type
Tfrm_Server = class(TForm)
IdTCPServer1: TIdTCPServer;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
Edit1: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
AFileStream: TFileStream; //传输的文件流
procedure ButtonBegin;
procedure ButtonEnd;
{ Private declarations }
public
{ Public declarations }
end;var
frm_Server: Tfrm_Server;implementation{$R *.dfm}procedure Tfrm_Server.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text := OpenDialog1.FileName;
end;procedure Tfrm_Server.Button4Click(Sender: TObject);
begin
Close;
end;procedure Tfrm_Server.Button2Click(Sender: TObject);
begin
if not FileExists(Edit1.Text) then //检测文件是否存在
begin
Showmessage('文件不存在,请选择文件!');
exit;
end;
//建立文件流
AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
ProgressBar1.Max := AFileStream.Size;
ProgressBar1.Position := 0;
ButtonBegin; //VCL开始状态设置
//服务器准备好连接
IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
if not IdTCPServer1.Active then IdTCPServer1.Active := True;
end;procedure Tfrm_Server.ButtonBegin;
begin //VCL开始状态设置
Button1.Enabled := False;
Button2.Enabled := False;
Button3.Enabled := True;
Button4.Enabled := False;
end;procedure Tfrm_Server.ButtonEnd;
begin //VCL结束状态设置
Button1.Enabled := True;
Button2.Enabled := True;
Button3.Enabled := False;
Button4.Enabled := True;
end;procedure Tfrm_Server.Button3Click(Sender: TObject);
begin
StatusBar1.SimpleText := '传输取消...';
AFileStream.Free; //释放文件流
ButtonEnd; //VCL结束状态设置
end;procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);
var
cmd: string; //接收到客户端的字符串信息
ASize: Integer; //需要传输的流大小
begin
with AThread.Connection do //已经连街上的一个进程
begin
cmd := UpperCase(ReadLn); //客户端发送的命令字符串
if cmd = 'BEGIN' then //开始传输
begin
//告诉远程传输文件的大小和文件名
WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
StatusBar1.SimpleText := '准备传输...';
Exit;
end;
if cmd = 'END' then
begin //传输完成
Button3.Click;
StatusBar1.SimpleText := '传输完成...';
Exit;
end;
if cmd = 'CANCEL' then
begin //传输取消
StatusBar1.SimpleText := '传输取消...';
//保持传输状态
Exit;
end;
//按照指定位置传输文件
AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置
ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
//计算需要发送的大小,Min()函数在Math单元
OpenWriteBuffer; //准备发送缓冲
WriteStream(AFileStream, false, false, ASize);
//注意这个函数的参数。
CloseWriteBuffer; //结束发送缓冲
StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]);
ProgressBar1.Position := ProgressBar1.Position + ASize;
end;
end;procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;type
Tfrm_Server = class(TForm)
IdTCPServer1: TIdTCPServer;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
Edit1: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
AFileStream: TFileStream; //传输的文件流
procedure ButtonBegin;
procedure ButtonEnd;
{ Private declarations }
public
{ Public declarations }
end;var
frm_Server: Tfrm_Server;implementation{$R *.dfm}procedure Tfrm_Server.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text := OpenDialog1.FileName;
end;procedure Tfrm_Server.Button4Click(Sender: TObject);
begin
Close;
end;procedure Tfrm_Server.Button2Click(Sender: TObject);
begin
if not FileExists(Edit1.Text) then //检测文件是否存在
begin
Showmessage('文件不存在,请选择文件!');
exit;
end;
//建立文件流
AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
ProgressBar1.Max := AFileStream.Size;
ProgressBar1.Position := 0;
ButtonBegin; //VCL开始状态设置
//服务器准备好连接
IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
if not IdTCPServer1.Active then IdTCPServer1.Active := True;
end;procedure Tfrm_Server.ButtonBegin;
begin //VCL开始状态设置
Button1.Enabled := False;
Button2.Enabled := False;
Button3.Enabled := True;
Button4.Enabled := False;
end;procedure Tfrm_Server.ButtonEnd;
begin //VCL结束状态设置
Button1.Enabled := True;
Button2.Enabled := True;
Button3.Enabled := False;
Button4.Enabled := True;
end;procedure Tfrm_Server.Button3Click(Sender: TObject);
begin
StatusBar1.SimpleText := '传输取消...';
AFileStream.Free; //释放文件流
ButtonEnd; //VCL结束状态设置
end;procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);
var
cmd: string; //接收到客户端的字符串信息
ASize: Integer; //需要传输的流大小
begin
with AThread.Connection do //已经连街上的一个进程
begin
cmd := UpperCase(ReadLn); //客户端发送的命令字符串
if cmd = 'BEGIN' then //开始传输
begin
//告诉远程传输文件的大小和文件名
WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
StatusBar1.SimpleText := '准备传输...';
Exit;
end;
if cmd = 'END' then
begin //传输完成
Button3.Click;
StatusBar1.SimpleText := '传输完成...';
Exit;
end;
if cmd = 'CANCEL' then
begin //传输取消
StatusBar1.SimpleText := '传输取消...';
//保持传输状态
Exit;
end;
//按照指定位置传输文件
AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置
ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
//计算需要发送的大小,Min()函数在Math单元
OpenWriteBuffer; //准备发送缓冲
WriteStream(AFileStream, false, false, ASize);
//注意这个函数的参数。
CloseWriteBuffer; //结束发送缓冲
StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]);
ProgressBar1.Position := ProgressBar1.Position + ASize;
end;
end;procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
end;end.
Client Code:procedure TForm2.Button1Click(Sender: TObject);
const
c_PackLen = $1000; //1K
var
SResponse : String;
fStream : TFileStream;
dcStream : TDecompressionStream; fSize : Integer;
iRcvLen : Integer;
begin
with TCPClient do
begin
Connect; while Connected do
begin
fStream := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
try
//Decompression
dcStream := TDecompressionStream.Create(fStream);
try
// banner means the server thread is running
SResponse := UpperCase(ReadLn);
if Pos('BEG', SResponse) = 0 then Break; fSize := StrToInt(Copy(SResponse, 4, Length(SResponse) - 3));
//Progress
pbDown.Max := fSize;
pbDown.Postion := 0; repeat
// request file data
WriteLn('SENDFILE'); { read all bytes until disconnected
length er in stream }
iRcvLen := ReadInteger();
ReadStream(dcStream, iRcvLen, True); pbDown.Postion := pbDown.Postion + iRcvLen; until iRcvLen < c_PackLen; finally
dcStream.Free;
end;
finally
Disconnect;
fStream.Free;
end;
end;
end;
end;
Server Code:procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);
const
c_PackLen = $1000; //1K
var
fStream : TFileStream;
cStream : TCompressionStream; iSendLen: Integer;
begin
with AThread.Connection do
begin
fStream := TFileStream(FileName, fmOpenRead or fmShareDenyNone);
try
//Compression
cStream := TCompressionStream.Create(clFastest, fStream);
try
WriteLn('BEG' + IntToStr(fStream.Size)); repeat
iSendLen := Min(c_PackLen, fStream.Size - fStream.Postion); OpenWriteBuffer;
try
WriteStream(cStream, False, True, iSendLen);
finally
CloseWriteBuffer;
end;
until iSendLen < c_PackLen;
finally
cStream.Free;
end;
finally
Disconnect;
fStream.free;
end;
end;
end;