关于多线程传送文件的程序(0分)

hly · 2002-10-21

输入socket点击查询发现很多人都在问许多重复的此问题，我也被这个问题困扰多日
那时用c++builder写的没有成功，放了一段时间后，现在用delphi写该程序（个人爱好而已）
，只能正确传送<80M的文件，>80M就会出错（自己功力不够啊）,我把我的源程序贴出来，
希望起到抛砖引玉的效果，同时希望修改好的DFW能把该好的程序贴出来共享一下，如果我
有时间我也会改进我的程序，让他无错的传送>500M以上的文件。
（Delphi5编译通过）

客户端：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ComCtrls, GradProgress, Menus;

type
TfrmClient = class(TForm)
clientsocket: TClientSocket;
btnSendFile: TButton;
StatusBar1: TStatusBar;
OpenDialog1: TOpenDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Host: TEdit;
Label1: TLabel;
Label2: TLabel;
Port: TEdit;
btnOpenFile: TButton;
GradProgress1: TProgressBar;
procedure btnSendFileClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure btnOpenFileClick(Sender: TObject);
private
FileSizes : array [0..10] of char;
iFileSizes :integer;
SendFile :File of byte;
m,n,i :integer;
{ Private declarations }
public
{ Public declarations }
end;

var
frmClient: TfrmClient;

implementation

{$R *.DFM}

procedure TfrmClient.btnSendFileClick(Sender: TObject);
var
MyClientSockets:TWinSocketStream;
ReadBuffer :array [0..2047] of Byte;
ReceiveText :array [0..99] of char;
SendText :array [0..99] of char;
Text :String;
NumRead :integer;
begin
i := SizeOf(ReadBuffer);
MyClientSockets:=TWinSocketStream.Create (ClientSocket.Socket,20);
StrPCopy(FileSizes,IntToStr(FileSize(SendFile)));
Text := OpenDialog1.FileName +';'+ IntToStr(FileSize(SendFile));
StrPCopy(SendText,Text);
MyClientSockets.Write(SendText,SizeOf(SendText));
MyClientSockets.WaitForData (1000);
MyClientSockets.Read(ReceiveText,SizeOf(ReceiveText));
Text := StrPas(ReceiveText);
if Text = 'Ok' then
begin
Seek(SendFile,soFromBeginning);
while iFileSizes>0 do
begin
BlockRead(SendFile,ReadBuffer,SizeOf(ReadBuffer),NumRead);
MyClientSockets.Write(ReadBuffer,NumRead);
iFileSizes := iFileSizes-NumRead;

if i>=StrToInt(FileSizes) then
GradProgress1.Position := 100
else
begin
n := Trunc(100*i/StrToInt(FileSizes));
if n=m then
begin
GradProgress1.Stepit;
m := m+1;
end;
end;
i := i+SizeOf(ReadBuffer);

end;
end;
CloseFile(SendFile);
MyClientSockets.WaitForData (1000);
MyClientSockets.Read(ReceiveText,SizeOf(ReceiveText));
Text := StrPas(ReceiveText);
if Text = 'Finished' then
Application.MessageBox('·&thorn;&Icirc;&ntilde;&AElig;÷&frac12;&Oacute;&Ecirc;&Otilde;&Icirc;&Auml;&frac14;&thorn;&sup3;&Eacute;&sup1;&brvbar;&pound;&iexcl;','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_ICONINFORMATION);
MyClientSockets.Free;
end;

procedure TfrmClient.N2Click(Sender: TObject);
begin
if ClientSocket.Active then
begin
Application.MessageBox('&Ograve;&Ntilde;&frac34;&shy;&Aacute;&not;&frac12;&Oacute;&micro;&frac12;&Iacute;¨&ETH;&Aring;·&thorn;&Icirc;&ntilde;&AElig;÷!','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_iconInformation);
Exit;
end;
try
ClientSocket.Host := Host.Text;
ClientSocket.Port := StrToInt(Port.Text);
ClientSocket.Active:=true;
Application.MessageBox('&Aacute;&not;&frac12;&Oacute;&sup3;&Eacute;&sup1;&brvbar;!','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_iconInformation);
except
Application.MessageBox('&Aacute;&not;&frac12;&Oacute;&Ecirc;§°&Uuml;!','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_ICONWARNING);
end;
end;

procedure TfrmClient.N3Click(Sender: TObject);
begin
if ClientSocket.Active then
ClientSocket.Active:=false;
end;

procedure TfrmClient.btnOpenFileClick(Sender: TObject);
begin
if not ClientSocket.Active then
begin
if Application.MessageBox('&Atilde;&raquo;&Oacute;&ETH;&Aacute;&not;&frac12;&Oacute;&micro;&frac12;&Iacute;¨&ETH;&Aring;·&thorn;&Icirc;&ntilde;&AElig;÷&pound;&not;&Auml;ú&Otilde;&aelig;&micro;&Auml;&Ograve;&ordf;&Aacute;&not;&frac12;&Oacute;&Acirc;&eth;&pound;&iquest;','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OKCancel+MB_iconInformation)=IDOk then
begin
try
ClientSocket.Host := Host.Text;
ClientSocket.Port := StrToInt(Port.Text);
ClientSocket.Active:=true;
Application.MessageBox('&Aacute;&not;&frac12;&Oacute;&sup3;&Eacute;&sup1;&brvbar;!','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_iconInformation);
except
Application.MessageBox('&Aacute;&not;&frac12;&Oacute;&Ecirc;§°&Uuml;!','&Igrave;á&Ecirc;&frac34;&pound;&ordm;',MB_OK+MB_ICONWARNING);
Exit;
end;
end
else
Exit;
end;
GradProgress1.Position :=0;
m := 1;
if OpenDialog1.Execute then
begin
StatusBar1.Panels[0].Text:= '·&cent;&Euml;&Iacute;&micro;&Auml;&Icirc;&Auml;&frac14;&thorn;&Atilde;&ucirc;&pound;&ordm;'+OpenDialog1.FileName;
AssignFile(SendFile,OpenDialog1.FileName);
Reset(SendFile);
iFileSizes := FileSize(SendFile);
StatusBar1.Panels[1].Text:= '&Icirc;&Auml;&frac14;&thorn;&acute;ó&ETH;&iexcl;&pound;&ordm;'+IntToStr(iFileSizes)+' Byte';
end;
end;

end.

//===========================================================================

服务器端：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
serversocket: TServerSocket;
StatusBar1: TStatusBar;
procedure serversocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
private
{ Private declarations }
public
{ Public declarations }
end;

TDealThread = class(TServerClientThread)
private
FMemoFileInfo :TMemo;
FileSizes :String; //&acute;&laquo;&Euml;&Iacute;&Icirc;&Auml;&frac14;&thorn;&acute;ó&ETH;&iexcl;
FileName :String;
protected
procedure Execute; override;
public
Thr:TServerClientWinSocket;
procedure GetFileNameAndSize(Text :String); {·&Ouml;&frac12;&acirc;&Icirc;&Auml;&frac14;&thorn;&Atilde;&ucirc;&ordm;&Iacute;&Icirc;&Auml;&frac14;&thorn;&acute;ó&ETH;&iexcl;}
procedure ReceiveFileInfo;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
{·&Ouml;&frac12;&acirc;&Icirc;&Auml;&frac14;&thorn;&Atilde;&ucirc;&ordm;&Iacute;&Icirc;&Auml;&frac14;&thorn;&acute;ó&ETH;&iexcl;}
procedure TDealThread.GetFileNameAndSize(Text :String);
var iPos :integer;
begin
iPos :=Pos(';',Text);
FileName := Copy(Text,1,iPos-1);
FileSizes := Copy(Text,iPos+1,Length(Text));
end;

procedure TDealThread.ReceiveFileInfo;
begin
FMemoFileInfo := TMemo.Create(Application);
FMemoFileInfo.Parent:=Form1;
FMemoFileInfo.Lines.Add(FileSizes+FileName);
end;

procedure TDealThread.Execute;
var
MySockets:TWinSocketStream;
ReceiveFile :File of Byte ;
WriteBuffer :array [0..2047] of Byte;
ReceiveText :array [0..99] of char;
SendText :array [0..99] of char;
Text :String;
InTransmiting :Boolean;
begin
InTransmiting := false;

while (not Terminated) and ClientSocket.Connected do
begin
// try
MySockets:=TWinSocketStream.Create (thr,360000);
Try
if not InTransmiting then
begin
MySockets.WaitForData (6000);
MySockets.Read(ReceiveText,SizeOf(ReceiveText));
Text := StrPas(ReceiveText);
if Length(Text)>0 then
begin
GetFileNameAndSize(Text);{·&Ouml;&frac12;&acirc;&Icirc;&Auml;&frac14;&thorn;&Atilde;&ucirc;&ordm;&Iacute;&Icirc;&Auml;&frac14;&thorn;&acute;ó&ETH;&iexcl;}
// Synchronize(ReceiveFileInfo);
AssignFile(ReceiveFile,'C:/hongzhenguo.zip');
Rewrite(ReceiveFile);
SendText := 'Ok';
MySockets.Write(SendText,SizeOf(SendText));
InTransmiting := true;
end
end
else
begin
while StrToInt(FileSizes)>0 do
begin
if StrToInt(FileSizes)<=SizeOf(WriteBuffer) then
begin
MySockets.WaitForData (6000);
MySockets.Read(WriteBuffer,StrToInt(FileSizes));
BlockWrite(ReceiveFile,WriteBuffer,StrToInt(FileSizes));
FileSizes := IntToStr(StrToInt(FileSizes)-StrToInt(FileSizes));
end
else
begin
MySockets.WaitForData (6000);
MySockets.Read(WriteBuffer,SizeOf(WriteBuffer));
BlockWrite(ReceiveFile,WriteBuffer,SizeOf(WriteBuffer));
FileSizes := IntToStr(StrToInt(FileSizes)-SizeOf(WriteBuffer));
end;
end;
CloseFile(ReceiveFile);
SendText := 'Finished';
MySockets.Write(SendText,SizeOf(SendText));
InTransmiting := False;
end;
finally
MySockets.Free;
end;
// except
// ShowMessage('error');
// end;
end;

end;

procedure TForm1.serversocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
var
Myt:TDealThread;
begin
Myt:=TdealThread.Create(false,ClientSocket) ;
Myt.thr :=ClientSocket;
SocketThread:=Myt;

end;

end.

softdog · 2002-10-25

用TClinetSocket和TServerSocket很不稳定，据说是有Bug，不过我还来不及仔细研究它们的源代码。
把缓冲区设置的小一点（<1024）可能情况会好一点。
还是用winsock的api函数吧！很稳定，我传了170M的一个文件没有碰到问题。

antic_ant · 2002-10-25

我写了一个，传一张光盘的内容都没问题

hq_pan · 2002-10-25

source? Only use WinSock API?
I want to know it...

ifeng · 2003-04-11

to hly
我照你的方法做了一个，传送文件不太稳定。在本机试，有时行，有时不行。
传到别的机器，文件不能打开。（传的都是zip,rar等压缩文件）
能不能把我修改好的让我看看 ifeng_xu@163.com
to softdog,antic_ant
能看看你们的代码吗？谢谢先

关于多线程传送文件的程序(0分)

hly

Unregistered / Unconfirmed

softdog

Unregistered / Unconfirmed

antic_ant

Unregistered / Unconfirmed

hq_pan

Unregistered / Unconfirmed

ifeng

Unregistered / Unconfirmed

Similar threads