用TIdTCPClient和TIdTCPServer,版本9，怎样实现多线程上传文件和下载文件（在INTERNET上） ( 积分: 300 )

小弟，参考盒子和其它地方下载“第八章 实例五 网络文件传输”和“Socket2”，自己试着写了一个上传和下载文件的东东，单独可以上传和下载文件，但是同时传输文件或下载文件就搞不定了，那位大侠能帮帮忙？我把源代码贴出（要是能给我调试我发到他的邮箱,我的:jierxrh@sohu.com）：
unit U_Server;

interface

uses
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);
procedure FormCreate(Sender: TObject);
private
AFileStream: TFileStream; //传输的文件流
RecFile: Boolean; //用于判断是上传文件还是下载文件
ASize, TotalSize: Integer; //需要传输的流大小
RecSize: int64;
procedure ButtonBegin;
procedure ButtonEnd;
{ Private declarations }
public
{ Public declarations }
end;

Const
MP_Request ='1'; //请求下载文件 Client
MP_RecFileSize ='2'; //返回文件大小 Server
MP_BeginRecData ='3'; //开始下载数据 Client
MP_SendData ='4'; //发送文件 Server

MP_ClientFile ='5';
MP_RecData ='6'; // 上传文件 server

MP_END ='7';
MP_CANCEL ='8'; //取消
MP_NODATA ='0'; //没有数据
var
frm_Server: Tfrm_Server;

implementation

{$R *.dfm}

procedure StrToStrings(const S, Delimiter: string; tmpSL: TStrings);
var i: integer;
tmpStr: string;
begin
tmpStr := S;
if tmpStr <> '' then
begin
if copy(tmpStr, length(tmpStr), 1) <> Delimiter then tmpStr := tmpStr + Delimiter;
while tmpStr <> '' do
begin
i := Pos(Delimiter, tmpStr);
tmpSL.Add(copy(tmpStr, 1, i - 1));
tmpStr := copy(tmpStr, i + 1, length(tmpStr) - i); ;
end;
end;
end;

function ExtractDelimitedStr(const S, Delimiter: string;
N: Integer): string;
var
tmpSL: TStrings;
begin
tmpSL := TStringList.Create;
try
StrToStrings(S, Delimiter, tmpSL); //转换为字串列表
if N > tmpSL.Count then
Result := ''
else
Result := tmpSL.Strings[N - 1];
finally
tmpSL.Free;
end;
end;

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开始状态设置

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
RecvCmd, DownFile, UpFile, tmpStr: string; //接收到客户端的字符串信息
Buff : array[0..1023] of Byte;
ReadCount : Integer;
begin
with AThread.Connection do //已经连街上的一个进程
begin
RecvCmd := UpperCase(ReadLn); //客户端发送的命令字符串

if RecFile then //下载文件
begin
// Case RecvCmd[1] of
// MP_END:
// begin
// RecFile := False;
// AFileStream.Free;
// Exit;
// end;
// end;
if RecSize < AFileStream.Size then
begin
//按照指定位置传输文件
AFileStream.Seek(StrToInT(RecvCmd), soFromBeginning); //转到文件流传输的位置
ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
//计算需要发送的大小，Min()函数在Math单元
OpenWriteBuffer; //准备发送缓冲
WriteStream(AFileStream, false, false, ASize);
//注意这个函数的参数。
CloseWriteBuffer; //结束发送缓冲
RecSize := RecSize + ASize;
end else
begin
RecFile := False;
FreeAndNil(AFileStream);
Exit;
end;
end;

if not RecFile then
begin
Case RecvCmd[1] of
MP_Request: //得到下载文件的路径
begin
DownFile := ExtractDelimitedStr(RecvCmd, '@', 2); //
DownFile := Edit1.Text; //测试用
if FileExists(DownFile) then //检测文件是否存在
begin
AFileStream := TFileStream.Create(DownFile, fmOpenRead or fmShareDenyNone); //
ASize := AFileStream.Size;
WriteLn(MP_RecFileSize + '@' + IntToStr(ASize)); //发送文件大小
RecFile := True;
end else
WriteLn(MP_NODATA + '@没有可以下载的文件！');
Exit;
end;
MP_ClientFile: //得到上传文件的路径 大小
begin
UpFile := ExtractDelimitedStr(RecvCmd, '@', 2); //存放路径
TotalSize := StrToInt(ExtractDelimitedStr(RecvCmd, '@', 3));
//UpFile := '路径' + UpFile;
tmpStr := ExtractDelimitedStr(RecvCmd, '@', 4); //文件名称
//TotalSize := StrToInt(tmpStr);
UpFile := UpFile + tmpStr;
//建立文件流准备接收
AFileStream := TFileStream.Create(UpFile, fmCreate);
// AThread.s State := dstReceiving;

WriteLn(MP_RecData); //发送文件大小

if not AThread.Terminated and Connected then
begin
//读取文件流
repeat
if TotalSize - AFileStream.Size > SizeOf(Buff) then
ReadCount := SizeOf(Buff)
else
ReadCount := TotalSize - AFileStream.Size;
ReadBuffer(Buff, ReadCount);
AFileStream.WriteBuffer(Buff, ReadCount);
//ProgressBar1.Position := AFileStream.Size;
//Caption := IntToStr(AFileStream.Size) + '/' + IntToStr(TotalSize);
Application.ProcessMessages;
until AFileStream.Size = TotalSize;
WriteLn(MP_END);
FreeAndNil(AFileStream);
end;
RecFile := False;
Exit;
end;
MP_CANCEL:
begin
FreeAndNil(AFileStream);
RecFile := False;
Exit;
end;
MP_END:
begin
FreeAndNil(AFileStream); //释放文件流
RecFile := False;
Exit;
end;
end;
end;
end;
end;


CLIENT:开始下载
procedure Tfrm_Client.BitBtn1Click(Sender: TObject);
var
RecvCmd, DownFile: string;
begin
//IdTCPClient1.Host := Edit1.Text; //连接主机
//IdTCPClient1.Port := StrToIntDef(Edit2.Text, 9925); //端口
IdTCPClient1.Connect; //连接

//1、发送要下载的文件路径
try
Edit5.Text := '源路径';
IdTCPClient1.WriteLn(MP_Request + '@'+ Edit5.Text); //提示服务器开始接收 'BEGIN' //请求下载文件 Client

RecvCmd := IdTCPClient1.ReadLn;
Case RecvCmd[1] of
MP_RecFileSize: //得到文件大小
begin
TotalSize := StrToInt(ExtractDelimitedStr(RecvCmd, '@', 2));
SaveDialog1.FileName := '';
if not SaveDialog1.Execute then
begin
IdTCPClient1.WriteLn(MP_CANCEL); //告诉服务器取消
IdTCPClient1.Disconnect; //断开连接
Exit;
end;
DownFile := SaveDialog1.FileName;
Edit4.Text := DownFile;
Edit3.Text := ExtractFileName(DownFile);
//开始接收文件
// ProgressBar1.Max:=ReadFileLen+AlreadyReadLen;
ProgressBar1.Max := TotalSize;
ProgressBar1.Position:=0;
//建立文件流准备接收
AFileStream := TFileStream.Create(DownFile, fmCreate);
try //循环开始接受
repeat
IdTCPClient1.WriteLn(IntToStr(AFileStream.Size));//发送当前传输的位置
ASize := Min(TotalSize - AFileStream.Size, IdTCPClient1.RecvBufferSize);
//选择剩余大小和缓冲区大小小的一个作为传输的大小
IdTCPClient1.ReadStream(AFileStream, ASize); //接收流
Self.Caption := Format('当前传输位置%d/大小%d', [AFileStream.Size, TotalSize]);
//ProgressBar1.Position:=ProgressBar1.Max;
ProgressBar1.Position := AFileStream.Position;
Application.ProcessMessages;
until AFileStream.Size = TotalSize; //大小一致了表示结束
finally
FreeAndNil(AFileStream); //释放文件流
//IdTCPClient1.WriteLn(MP_END);
end;

end;
MP_NODATA: //没有文件可以下载
begin
ShowMessage(ExtractDelimitedStr(RecvCmd, '@', 2));
end;
end;

//IdTCPClient1.WriteLn(MP_END); //提示服务器传输完成
Self.Caption :='下载完毕！ 共：'+IntToStr(ProgressBar1.Max)+'字节';
except
Self.Caption := '连接服务器失败或者对方已经中断传输！';
IdTCPClient1.Disconnect;
end;
IdTCPClient1.Disconnect;
end;

CLIENT:上传
procedure TUpLoadFm.BitBtn2Click(Sender: TObject);
var
RecvCmd, UpFile:String;
Buf : array[0..1023] of Byte;
ReadCount : Integer;
begin
// UpLoadTcp.Host := '127.0.0.1'; //连接主机
// UpLoadTcp.Port := 9925; //端口
UpLoadTcp.Connect; //连接

// UpLoadFile:=Edit2.Text+Edit1.Text;
if not OpenDialog1.Execute then Exit;
UpLoadFile := OpenDialog1.FileName;
AFileStream := TFileStream.Create(UpLoadFile, fmOpenRead or fmShareDenyNone);
TotalSize := AFileStream.Size;
Edit2.Text := UpLoadFile;
Edit1.Text := ExtractFileName(UpLoadFile);
if Not FileExists(UpLoadFile) then
begin
Self.Caption:='请重新选择文件，该文件不存在！';
Beep; exit;
end;
Animate1.Active:=True;
Bitbtn2.Enabled:=False;
Bitbtn1.Enabled:=False;

UpFile := 'D:/';
Edit3.Text := UpFile + Edit1.Text;
try //发送下载的文件
UpLoadTcp.WriteLn(MP_ClientFile + '@'+ UpFile + '@'+ IntToStr(TotalSize) + '@'+ Edit1.Text);
RecvCmd := UpLoadTcp.ReadLn;
Case RecvCmd[1] of
MP_RecData: //得到文件大小
begin
//写文件长度和文件流
ProgressBar1.Max := TotalSize;
//UpLoadTcp.WriteBuffer(TotalSize, 4);
//UpLoadTcp.WriteStream(AFileStream);
while AFileStream.Position < AFileStream.Size do
begin
if AFileStream.Size - AFileStream.Position >= SizeOf(Buf) then
ReadCount := sizeOf(Buf)
else
ReadCount := AFileStream.Size - AFileStream.Position;
AFileStream.ReadBuffer(Buf, ReadCount);
UpLoadTcp.WriteBuffer(Buf, ReadCount);
ProgressBar1.Position := AFileStream.Position;
Application.ProcessMessages;
end;
//Caption := UpLoadTcp.ReadLn;
UpLoadTcp.Disconnect;
FreeAndNil(AFileStream);
end;
MP_END:
begin
UpLoadTcp.Disconnect;
FreeAndNil(AFileStream);
ShowMessage('上传完成！');
end;
end;

//UpLoadTcp.Disconnect;
Self.Caption:='文件发送完毕！共发送：' + IntToStr(TotalSize)+'字节';

Animate1.Active := False;
Bitbtn2.Enabled := False;
Bitbtn1.Enabled := True;
if CheckBox1.Checked then Close;
exit;Beep;
except
Self.Caption:='请检查网络连接是否正常！';
Animate1.Active := False;
Beep;
end;
end;

http://www.51zhan.com 最好的网址站
http://www.51zhan.com 最好的网址站
http://www.51zhan.com 最好的网址站

我见过一个比你还好的方法。你的点了过滤列表之后窗体就失去焦点了。这种方法不好

TO dawnsoft,兄弟，什么软件啊？我看看去。有比我这个方便过滤的，恩，我一定要超过它。

http://kinneng.go1.icpcn.com/wendang.html

TO dawnsoft,兄弟,
下不了，而且还声明：自用控件，未尽完善，未经测试，友情贴出，仅作参考
不使用怎么叫控件呢！
DFW，怎么贴图出来呢

哇,大散分啊

是啊，是啊

可以可以
拿分