关于局域网内对多客户稳定传送文件的问题（Indy） ( 积分: 100 )

  • 主题发起人 主题发起人 Rain_Cui
  • 开始时间 开始时间
R

Rain_Cui

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟是新手，练习写一个文件传送的程序。当单个用户的时候没有问题，但是当从在线用户列表中对多用户同时进行传送的时候，总是出现错误。估计是线程问题，应该再OnConnect和DisConnect中直接加入线程代码，小弟想用Tidthreadmgrdefault 解决，但是苦于暂时无法找到相关资料，希望各位高手指导！代码如下：

unit U_Server;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math,
IDTCPConnection,IDStack, IdThreadMgr, IdThreadMgrDefault,ShellAPI;

type
Tfrm_Server = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
Edit1: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
Button5: TButton;
Button6: TButton;
GroupBox1: TGroupBox;
ListBox1: TListBox;
IdThreadManager: TIdThreadMgrDefault;
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);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
// procedure ListBox1DblClick(Sender: TObject);
private
AFileStream: TFileStream; //file Stream
procedure ButtonBegin;
procedure ButtonEnd;
{ Private declarations }
public
{ Public declarations }
end;

{TNewWindow=Class(TThread)
private
PeePIP: string;
procedure CreateNewWindow;
protected
procedure Execute; override;
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 //Check the file
begin
Showmessage('File not be found,Please select file!');
exit;
end;
//Create the file stream
AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
ProgressBar1.Max := AFileStream.Size;
ProgressBar1.Position := 0;
ButtonBegin;
//Start server
IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
if not IdTCPServer1.Active then IdTCPServer1.Active := True;
end;

procedure Tfrm_Server.ButtonBegin;
begin
Button1.Enabled := False;
Button2.Enabled := False;
Button3.Enabled := True;
Button4.Enabled := False;
end;

procedure Tfrm_Server.ButtonEnd;
begin
Button1.Enabled := True;
Button2.Enabled := True;
Button3.Enabled := False;
Button4.Enabled := True;
end;

procedure Tfrm_Server.Button3Click(Sender: TObject);
begin
StatusBar1.SimpleText := 'Transfer be canceled...';
AFileStream.Free; //free stream
ButtonEnd;
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
//transfer the name and size
WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
StatusBar1.SimpleText := 'Prepare...';
Exit;
end;
if cmd = 'END' then
begin
Button3.Click;
StatusBar1.SimpleText := 'Complete...';
Exit;
end;
if cmd = 'CANCEL' then
begin
StatusBar1.SimpleText := 'Transfer be canceled...';
Exit;
end;
AFileStream.Seek(StrToInT(cmd), soFromBeginning);
ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
OpenWriteBuffer;
WriteStream(AFileStream, false, false, ASize);
CloseWriteBuffer;
StatusBar1.SimpleText := Format('Location%s/Size%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;

procedure Tfrm_Server.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Button5.Hide;
Button6.Show;
idTCPserver1.Active:=True;
Memo1.Lines.Add('Server Started');
end;

procedure Tfrm_Server.Button6Click(Sender: TObject);
begin
IDTCPServer1.Active:=False;
Button5.Show;
Button6.Hide;
Memo1.Lines.Add('Server Closed');
end;

procedure Tfrm_Server.Button5Click(Sender: TObject);
begin
IDTCPServer1.Active:= True;
Memo1.Clear;
Button5.Hide;
Button6.Show;
Memo1.Lines.Add('Server Started');
end;

procedure Tfrm_Server.IdTCPServer1Connect(AThread: TIdPeerThread);
var ComputerName: string;
PeePIP: string;
begin
PeePIP:=AThread.Connection.Socket.Binding.PeerIP;
ComputerName:=GStack.WSGetHostByAddr(PeePIP);
Memo1.Lines.Add(TimeToStr(Time)+ 'From Computer:' + ComputerName);
ListBox1.Items.Add(ComputerName);
end;

procedure Tfrm_Server.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var ComputerName: string;
PeePIP: string;
C:integer;
begin
PeePIP:=AThread.Connection.Socket.Binding.PeerIP;
ComputerName:=GStack.WSGetHostByAddr(PeePIP);
for c:=0 to ListBox1.Count-1 do
begin
if ListBox1.Items[C]= ComputerName Then
ListBox1.Items.Delete(C);
end;
Memo1.Lines.Add(TimeToStr(Time)+'DisConnect Form Computer:'+ ComputerName);
end;

end.

 
小弟是新手，练习写一个文件传送的程序。当单个用户的时候没有问题，但是当从在线用户列表中对多用户同时进行传送的时候，总是出现错误。估计是线程问题，应该再OnConnect和DisConnect中直接加入线程代码，小弟想用Tidthreadmgrdefault 解决，但是苦于暂时无法找到相关资料，希望各位高手指导！代码如下：

unit U_Server;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math,
IDTCPConnection,IDStack, IdThreadMgr, IdThreadMgrDefault,ShellAPI;

type
Tfrm_Server = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
Edit1: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
Button5: TButton;
Button6: TButton;
GroupBox1: TGroupBox;
ListBox1: TListBox;
IdThreadManager: TIdThreadMgrDefault;
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);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
// procedure ListBox1DblClick(Sender: TObject);
private
AFileStream: TFileStream; //file Stream
procedure ButtonBegin;
procedure ButtonEnd;
{ Private declarations }
public
{ Public declarations }
end;

{TNewWindow=Class(TThread)
private
PeePIP: string;
procedure CreateNewWindow;
protected
procedure Execute; override;
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 //Check the file
begin
Showmessage('File not be found,Please select file!');
exit;
end;
//Create the file stream
AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
ProgressBar1.Max := AFileStream.Size;
ProgressBar1.Position := 0;
ButtonBegin;
//Start server
IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
if not IdTCPServer1.Active then IdTCPServer1.Active := True;
end;

procedure Tfrm_Server.ButtonBegin;
begin
Button1.Enabled := False;
Button2.Enabled := False;
Button3.Enabled := True;
Button4.Enabled := False;
end;

procedure Tfrm_Server.ButtonEnd;
begin
Button1.Enabled := True;
Button2.Enabled := True;
Button3.Enabled := False;
Button4.Enabled := True;
end;

procedure Tfrm_Server.Button3Click(Sender: TObject);
begin
StatusBar1.SimpleText := 'Transfer be canceled...';
AFileStream.Free; //free stream
ButtonEnd;
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
//transfer the name and size
WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
StatusBar1.SimpleText := 'Prepare...';
Exit;
end;
if cmd = 'END' then
begin
Button3.Click;
StatusBar1.SimpleText := 'Complete...';
Exit;
end;
if cmd = 'CANCEL' then
begin
StatusBar1.SimpleText := 'Transfer be canceled...';
Exit;
end;
AFileStream.Seek(StrToInT(cmd), soFromBeginning);
ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
OpenWriteBuffer;
WriteStream(AFileStream, false, false, ASize);
CloseWriteBuffer;
StatusBar1.SimpleText := Format('Location%s/Size%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;

procedure Tfrm_Server.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Button5.Hide;
Button6.Show;
idTCPserver1.Active:=True;
Memo1.Lines.Add('Server Started');
end;

procedure Tfrm_Server.Button6Click(Sender: TObject);
begin
IDTCPServer1.Active:=False;
Button5.Show;
Button6.Hide;
Memo1.Lines.Add('Server Closed');
end;

procedure Tfrm_Server.Button5Click(Sender: TObject);
begin
IDTCPServer1.Active:= True;
Memo1.Clear;
Button5.Hide;
Button6.Show;
Memo1.Lines.Add('Server Started');
end;

procedure Tfrm_Server.IdTCPServer1Connect(AThread: TIdPeerThread);
var ComputerName: string;
PeePIP: string;
begin
PeePIP:=AThread.Connection.Socket.Binding.PeerIP;
ComputerName:=GStack.WSGetHostByAddr(PeePIP);
Memo1.Lines.Add(TimeToStr(Time)+ 'From Computer:' + ComputerName);
ListBox1.Items.Add(ComputerName);
end;

procedure Tfrm_Server.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var ComputerName: string;
PeePIP: string;
C:integer;
begin
PeePIP:=AThread.Connection.Socket.Binding.PeerIP;
ComputerName:=GStack.WSGetHostByAddr(PeePIP);
for c:=0 to ListBox1.Count-1 do
begin
if ListBox1.Items[C]= ComputerName Then
ListBox1.Items.Delete(C);
end;
Memo1.Lines.Add(TimeToStr(Time)+'DisConnect Form Computer:'+ ComputerName);
end;

end.

 
您必须登录或注册才可回复。

Similar threads

B
学习TServerSocket 和 TClientSocket进行文件传输，为什么多个Client同时向Server传时，出现如下错误： (30分)
回复
7
查看
221
wab
W
M
我抄的网上泛滥的spcomm例子，只能发送，为什么收不到？？过来看看(50分)
回复
9
查看
203
我爱飞
我
J
急！急！急！一个简单的socket发送接收信息的问题！(50分)
回复
2
查看
159
jhjk
J
S
我准备做一个像MSN的邮件提示一样打开窗口的程序,请教高手,有没有相关的函数.谢谢.在线等待...(100分)
回复
4
查看
195
seeme0526
S
H
关于多线程传送文件的程序(0分)
回复
4
查看
218
ifeng
I
后退
顶部