socket多线程通讯，请高人相助！ ( 积分: 100 )

  • 主题发起人 主题发起人 NeverMind
  • 开始时间 开始时间
N

NeverMind

Unregistered / Unconfirmed
GUEST, unregistred user!
client端：
type
TClientThread = class(TThread)
private
{ Private declarations }
IP: string;
PortNo: integer;
SendFile: string;
ClientSocket: TClientSocket;
reConnectTime: integer;
iPackID: integer;
iLeftSize: integer;
PackCount: integer;
fileStream: TFileStream;
protected
procedure Execute; override;
procedure SetReConnectTime(Time: integer);
public
constructor Create(CreateSuspended: Boolean;HostIP: string;HostPort: integer;FileName: string);
destructor Destory;
procedure ClientSocketError(Sender: TObject;Socket: TCustomWinSocket;ErrorEvent: TerrorEvent; var ErrorCode: Integer);
procedure ClientSocketConnect(Sender: TObject;Socket: TCustomWinSocket);
procedure ClientSocketOnRead(Sender: TObject;Socket: TCustomWinSocket);
function Open: Boolean;
function GetPackCount(var FileName:String):Integer;
procedure UpdateData(var iLeftSize: integer; DataPack: TPackRecord);
property ConnectTime: integer read reConnectTime write SetReConnectTime;
end;

implementation


procedure TClientThread.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
PackHead: TPackHead;
begin
ClientSocket.Active := True;
PackHead.PackType := ptFirst;
PackHead.ThreadID := Self.ThreadID;
PackHead.FileName := Copy(SendFile,StringLocation('/',SendFile)+1,Length(SendFile)-StringLocation('/',SendFile)+1);
PackHead.PackCount := PackCount;
ClientSocket.Socket.SendBuf(PackHead,SizeOf(PackHead));
end;

procedure TClientThread.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TerrorEvent;
var ErrorCode: Integer);
begin
ClientSocket.Close;
ErrorCode := 0;
end;

procedure TClientThread.ClientSocketOnRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Protocol: TProtocols;
Command: TProtocol;
DataPack: TPackRecord;
begin
while (not Terminated) and (not suspended) do
begin
Protocol := [START,NEXT,OVER];
DelayTime(10);
Socket.ReceiveBuf(Command,Socket.ReceiveLength);
if (Command in Protocol) and (SendFile <> '') then
begin
case Command of
START: begin
fileStream := TFileStream.Create(SendFile,fmOpenRead,fmShareDenyWrite);
iLeftSize := fileStream.Size;
end;
OVER: begin
ClientSocket.Close;
Terminate;
Destory;
end;
end;
UpdateData(iLeftSize,DataPack);
end;
end;
end;

constructor TClientThread.Create(CreateSuspended: Boolean; HostIP: string;
HostPort: integer;FileName: string);
begin
inherited create(true);
FreeOnTerminate := True;
ClientSocket := TClientSocket.Create(nil);
IP := HostIP;
PortNo := HostPort;
with ClientSocket do
begin
Address := IP;
Port := PortNo;
ClientType := ctNonBlocking;
OnError := ClientSocketError;
OnConnect := ClientSocketConnect;
OnRead := ClientSocketOnRead;
end;

SendFile := FileName;
PackCount := GetPackCount(SendFile);
end;


procedure TClientThread.SetReConnectTime(Time: integer);
begin
if ReConnectTime <> Time then
ReConnectTime := Time;
end;


procedure TClientThread.Execute;
begin
Open;
end;

function TClientThread.Open: Boolean;
var
i: integer;
begin
i := 0;
while i < reConnectTime do
begin
ClientSocket.Open;
DelayTime(150);
if ClientSocket.Active then
Break;
inc(i);
end;
result := ClientSocket.Active;
end;

destructor TClientThread.Destory;
begin
ClientSocket.Free;
fileStream.Free;
inherited free;
end;

function TClientThread.GetPackCount(var FileName: String): Integer;
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName,fmOpenRead,fmShareDenyWrite );
if (Stream.Size mod CACHESIZE) <> 0 then
PackCount := (Stream.Size div CACHESIZE)+1
else
PackCount := Stream.Size div CACHESIZE;
Stream.Free;
result := PackCount;
end;

procedure TClientThread.UpdateData(var iLeftSize: integer;DataPack: TPackRecord);
begin
if iLeftSize <= CACHESIZE then
begin
with DataPack do
begin
PackType := ptLast;
Size := iLeftSize;
PackID := iPackID+1;
fileStream.Read(Cache,iLeftSize);
iLeftSize := 0;
end;
end
else
begin
with DataPack do
begin
PackType :=ptNormal;
Size :=CACHESIZE;
PackID :=iPackID+1;
Inc(iPackID);
fileStream.Read(Cache,CACHESIZE);
iLeftSize:=iLeftSize - CACHESIZE;
end;
end;
ClientSocket.Socket.SendBuf(DataPack,SizeOf(DataPack));
//DelayTime(100);
end;


//*************************************************************************//
Server端



type
TServerThread = class(TServerClientThread)
private
{ Private declarations }
ReceiveFileName :String;
fileStream :TFileStream;
iPackID :cardinal;
protected
//procedure Execute; override;
procedure ClientExecute;override;
public
Constructor Create(CreateSuspended:Boolean;ASocket:TServerClientWinSocket);virtual;
destructor Destory;virtual;
procedure OnAccept;
procedure ClientRead;
//function StartConnect: Boolean;virtual;
end;


implementation

procedure TServerThread.ClientExecute;
var
Stream : TWinSocketStream;
begin
while not Terminated and ClientSocket.Connected do
begin
try
Stream := TWinSocketStream.Create(ClientSocket, 60000);
try
if Stream.WaitForData(60000) then
begin
OnAccept;
fileStream := TFileStream.Create('d:/'+ReceiveFileName,fmCreate,fmShareExclusive);
ClientRead;
Destory;
end
else
ClientSocket.Close;
finally
Stream.Free;
end;
except
HandleException;
end;
end;
end;

procedure TServerThread.ClientRead;
var
PackType :TPackTypes;
DataRecord :TPackRecord;
Protocol :TProtocol;
begin
while not terminated and ClientSocket.Connected do
begin
PackType :=[ptNormal,ptLast];
ClientSocket.ReceiveBuf(DataRecord,ClientSocket.ReceiveLength);
if (DataRecord.PackType in PackType) and (DataRecord.PackID = iPackID+1) then
begin

fileStream.Write(DataRecord.Cache,DataRecord.Size);
case DataRecord.PackType of
ptNormal:
begin
iPackID :=DataRecord.PackID;
Protocol :=NEXT;
ClientSocket.SendBuf(Protocol,SizeOf(Protocol));
end;
ptLast:
begin
Protocol :=OVER;
Sleep(50);
ClientSocket.SendBuf(Protocol,SizeOf(Protocol));
DelayTime(100);
self.Destory;
end;
end;
end;
end;
end;

constructor TServerThread.Create(CreateSuspended: Boolean;ASocket: TServerClientWinSocket);
begin
inherited Create(false,ASocket);
FreeOnTerminate := True;
end;

destructor TServerThread.Destory;
begin
Terminate;
fileStream.Free;
inherited free;
end;

procedure TServerThread.OnAccept;
var
MainPack :TPackHead;
Command :TProtocol;
PackType :TPackTypes;
begin
ClientSocket.ReceiveBuf(MainPack,ClientSocket.ReceiveLength);
PackType :=[ptFirst];
if MainPack.PackType in PackType then
begin
ReceiveFileName :=MainPack.FileName;
Command :=START;
ClientSocket.SendBuf(Command,SizeOf(Command));
end;
end;

end.



//**************************************************************************//
公用部分
const CACHESIZE=1024; //若不是1024，则在测试传送文本时产生乱码，不解！－－－问题2

type
TProtocol = (START,NEXT,OVER);
TProtocols = set of TProtocol;
TPackType = (ptFirst,ptNormal,ptLast);
TPackTypes = set of TPackType;
TNetStatus = (nsNone,nsConnected,nsConnectFail,nsTransOver);

TPackRecord = packed record
PackType :TPackType;
Size :Integer;
PackID :Cardinal;
Cache :Array [1..CACHESIZE] of Char;
end;

type
TPackHead = packed Record
PackType :TPackType;
ThreadID :Integer;
FileName :String[255];
PackCount :Integer;
end;


var
tsThread: TList;
CS: TRTLCriticalSection;
hMutex: THandle = 0;

procedure DelayTime(_T :Cardinal);
function StringLocation(strTraget:string;strSource:string):Integer;
implementation


procedure DelayTime(_T:Cardinal);
var
StartTime :Cardinal;
begin
StartTime :=GetTickCount;
while (GetTickCount-StartTime) < _T do
Application.ProcessMessages;
end;


function StringLocation(strTraget:string;strSource:string):Integer;
var
iIndex:Integer;
begin
iIndex:=Length(strSource)-1;
while strTraget<>strSource[iIndex] do
begin
iIndex := iIndex -1 ;
end;
if strTraget=strSource[iIndex] then
Result:=iIndex
else
Result:=-1;
end;

end.

呵呵，东西多了点，让大伙看着受累了！我现在就是单文件传送，都很不稳定：1.)传送文件，有时候成功，有时候不成功；2.)见公用部分第一行；3.)传送速度慢！
盼高人相助，不胜感激！
 
client端：
type
TClientThread = class(TThread)
private
{ Private declarations }
IP: string;
PortNo: integer;
SendFile: string;
ClientSocket: TClientSocket;
reConnectTime: integer;
iPackID: integer;
iLeftSize: integer;
PackCount: integer;
fileStream: TFileStream;
protected
procedure Execute; override;
procedure SetReConnectTime(Time: integer);
public
constructor Create(CreateSuspended: Boolean;HostIP: string;HostPort: integer;FileName: string);
destructor Destory;
procedure ClientSocketError(Sender: TObject;Socket: TCustomWinSocket;ErrorEvent: TerrorEvent; var ErrorCode: Integer);
procedure ClientSocketConnect(Sender: TObject;Socket: TCustomWinSocket);
procedure ClientSocketOnRead(Sender: TObject;Socket: TCustomWinSocket);
function Open: Boolean;
function GetPackCount(var FileName:String):Integer;
procedure UpdateData(var iLeftSize: integer; DataPack: TPackRecord);
property ConnectTime: integer read reConnectTime write SetReConnectTime;
end;

implementation


procedure TClientThread.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
PackHead: TPackHead;
begin
ClientSocket.Active := True;
PackHead.PackType := ptFirst;
PackHead.ThreadID := Self.ThreadID;
PackHead.FileName := Copy(SendFile,StringLocation('/',SendFile)+1,Length(SendFile)-StringLocation('/',SendFile)+1);
PackHead.PackCount := PackCount;
ClientSocket.Socket.SendBuf(PackHead,SizeOf(PackHead));
end;

procedure TClientThread.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TerrorEvent;
var ErrorCode: Integer);
begin
ClientSocket.Close;
ErrorCode := 0;
end;

procedure TClientThread.ClientSocketOnRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Protocol: TProtocols;
Command: TProtocol;
DataPack: TPackRecord;
begin
while (not Terminated) and (not suspended) do
begin
Protocol := [START,NEXT,OVER];
DelayTime(10);
Socket.ReceiveBuf(Command,Socket.ReceiveLength);
if (Command in Protocol) and (SendFile <> '') then
begin
case Command of
START: begin
fileStream := TFileStream.Create(SendFile,fmOpenRead,fmShareDenyWrite);
iLeftSize := fileStream.Size;
end;
OVER: begin
ClientSocket.Close;
Terminate;
Destory;
end;
end;
UpdateData(iLeftSize,DataPack);
end;
end;
end;

constructor TClientThread.Create(CreateSuspended: Boolean; HostIP: string;
HostPort: integer;FileName: string);
begin
inherited create(true);
FreeOnTerminate := True;
ClientSocket := TClientSocket.Create(nil);
IP := HostIP;
PortNo := HostPort;
with ClientSocket do
begin
Address := IP;
Port := PortNo;
ClientType := ctNonBlocking;
OnError := ClientSocketError;
OnConnect := ClientSocketConnect;
OnRead := ClientSocketOnRead;
end;

SendFile := FileName;
PackCount := GetPackCount(SendFile);
end;


procedure TClientThread.SetReConnectTime(Time: integer);
begin
if ReConnectTime <> Time then
ReConnectTime := Time;
end;


procedure TClientThread.Execute;
begin
Open;
end;

function TClientThread.Open: Boolean;
var
i: integer;
begin
i := 0;
while i < reConnectTime do
begin
ClientSocket.Open;
DelayTime(150);
if ClientSocket.Active then
Break;
inc(i);
end;
result := ClientSocket.Active;
end;

destructor TClientThread.Destory;
begin
ClientSocket.Free;
fileStream.Free;
inherited free;
end;

function TClientThread.GetPackCount(var FileName: String): Integer;
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName,fmOpenRead,fmShareDenyWrite );
if (Stream.Size mod CACHESIZE) <> 0 then
PackCount := (Stream.Size div CACHESIZE)+1
else
PackCount := Stream.Size div CACHESIZE;
Stream.Free;
result := PackCount;
end;

procedure TClientThread.UpdateData(var iLeftSize: integer;DataPack: TPackRecord);
begin
if iLeftSize <= CACHESIZE then
begin
with DataPack do
begin
PackType := ptLast;
Size := iLeftSize;
PackID := iPackID+1;
fileStream.Read(Cache,iLeftSize);
iLeftSize := 0;
end;
end
else
begin
with DataPack do
begin
PackType :=ptNormal;
Size :=CACHESIZE;
PackID :=iPackID+1;
Inc(iPackID);
fileStream.Read(Cache,CACHESIZE);
iLeftSize:=iLeftSize - CACHESIZE;
end;
end;
ClientSocket.Socket.SendBuf(DataPack,SizeOf(DataPack));
//DelayTime(100);
end;


//*************************************************************************//
Server端



type
TServerThread = class(TServerClientThread)
private
{ Private declarations }
ReceiveFileName :String;
fileStream :TFileStream;
iPackID :cardinal;
protected
//procedure Execute; override;
procedure ClientExecute;override;
public
Constructor Create(CreateSuspended:Boolean;ASocket:TServerClientWinSocket);virtual;
destructor Destory;virtual;
procedure OnAccept;
procedure ClientRead;
//function StartConnect: Boolean;virtual;
end;


implementation

procedure TServerThread.ClientExecute;
var
Stream : TWinSocketStream;
begin
while not Terminated and ClientSocket.Connected do
begin
try
Stream := TWinSocketStream.Create(ClientSocket, 60000);
try
if Stream.WaitForData(60000) then
begin
OnAccept;
fileStream := TFileStream.Create('d:/'+ReceiveFileName,fmCreate,fmShareExclusive);
ClientRead;
Destory;
end
else
ClientSocket.Close;
finally
Stream.Free;
end;
except
HandleException;
end;
end;
end;

procedure TServerThread.ClientRead;
var
PackType :TPackTypes;
DataRecord :TPackRecord;
Protocol :TProtocol;
begin
while not terminated and ClientSocket.Connected do
begin
PackType :=[ptNormal,ptLast];
ClientSocket.ReceiveBuf(DataRecord,ClientSocket.ReceiveLength);
if (DataRecord.PackType in PackType) and (DataRecord.PackID = iPackID+1) then
begin

fileStream.Write(DataRecord.Cache,DataRecord.Size);
case DataRecord.PackType of
ptNormal:
begin
iPackID :=DataRecord.PackID;
Protocol :=NEXT;
ClientSocket.SendBuf(Protocol,SizeOf(Protocol));
end;
ptLast:
begin
Protocol :=OVER;
Sleep(50);
ClientSocket.SendBuf(Protocol,SizeOf(Protocol));
DelayTime(100);
self.Destory;
end;
end;
end;
end;
end;

constructor TServerThread.Create(CreateSuspended: Boolean;ASocket: TServerClientWinSocket);
begin
inherited Create(false,ASocket);
FreeOnTerminate := True;
end;

destructor TServerThread.Destory;
begin
Terminate;
fileStream.Free;
inherited free;
end;

procedure TServerThread.OnAccept;
var
MainPack :TPackHead;
Command :TProtocol;
PackType :TPackTypes;
begin
ClientSocket.ReceiveBuf(MainPack,ClientSocket.ReceiveLength);
PackType :=[ptFirst];
if MainPack.PackType in PackType then
begin
ReceiveFileName :=MainPack.FileName;
Command :=START;
ClientSocket.SendBuf(Command,SizeOf(Command));
end;
end;

end.



//**************************************************************************//
公用部分
const CACHESIZE=1024; //若不是1024，则在测试传送文本时产生乱码，不解！－－－问题2

type
TProtocol = (START,NEXT,OVER);
TProtocols = set of TProtocol;
TPackType = (ptFirst,ptNormal,ptLast);
TPackTypes = set of TPackType;
TNetStatus = (nsNone,nsConnected,nsConnectFail,nsTransOver);

TPackRecord = packed record
PackType :TPackType;
Size :Integer;
PackID :Cardinal;
Cache :Array [1..CACHESIZE] of Char;
end;

type
TPackHead = packed Record
PackType :TPackType;
ThreadID :Integer;
FileName :String[255];
PackCount :Integer;
end;


var
tsThread: TList;
CS: TRTLCriticalSection;
hMutex: THandle = 0;

procedure DelayTime(_T :Cardinal);
function StringLocation(strTraget:string;strSource:string):Integer;
implementation


procedure DelayTime(_T:Cardinal);
var
StartTime :Cardinal;
begin
StartTime :=GetTickCount;
while (GetTickCount-StartTime) < _T do
Application.ProcessMessages;
end;


function StringLocation(strTraget:string;strSource:string):Integer;
var
iIndex:Integer;
begin
iIndex:=Length(strSource)-1;
while strTraget<>strSource[iIndex] do
begin
iIndex := iIndex -1 ;
end;
if strTraget=strSource[iIndex] then
Result:=iIndex
else
Result:=-1;
end;

end.

呵呵，东西多了点，让大伙看着受累了！我现在就是单文件传送，都很不稳定：1.)传送文件，有时候成功，有时候不成功；2.)见公用部分第一行；3.)传送速度慢！
盼高人相助，不胜感激！
 
是不是太长了，大伙都不愿意看呢？
 
用indy的组件，本身就是多线程的，应该更方便。还没详细研究过socket,惭愧！
 
你这样写代码，完全失去了TCP连接的优势，得到的效果，跟UDP没什么两样。TCP连接的优
势是什么？根本用不着你的把数据拆分成一个一个的数据包，接收后再一个一个分拆、判断
。。。其实只需要使用ReceiveBuf()与SendBuf()就可以了。你肯定会问，Client与Server
端如何知道要传送什么文件？文件大小是什么？其实你只要参考一下FTP的原理，什么都
明白了。
 
www.51merit.com
上有
 
非常感谢smokingroom！我对FTP的原理知之甚少，还请指点一二！
13708782004，呵呵，上面的东东下不了啊！
 
反对 smokingroom,

TCP　也要拆包的，
如果包太大了， 某个客户端就会带宽用完，
　别人的数据就发不了了，特别是如果别人用的是UDP 全会丢掉

流量控制是要做的


没有见到你的线程　中有锁
 
客户端没必要用多线程；

在SERVERSOCKET1中可选择非阻塞方式或线程阻塞方式;
在ClientSOCKET1中可选择非阻塞方式或阻塞方式;

不用这么麻烦吧
 
jlyin，我是想在客户端同时传送多个文件到server端，client与server是N:M得关系，如果不用多线程，那用什么方法呢？
 
不用多线程也示尚不可，
我测试的聊天程序，
SERVER只开一个SOCKET端口，按线连接：
ServerSocket1.Socket.Connections.SendText('&amp;Iacute;&amp;oslash;&amp;sup1;&amp;Uuml;:'+TempStr);
同一台电脑可开多个客户端，效果相当，

你客户端用多线程，是否每个线程的通讯，选择服务器的SOCKET不同？
 
jlyin,是的
 
怎么莫人回答俺的问题啊
 
以下是用线程和阻塞方式写的。
const FileBufferSize = 1024;

type TSendThread = Class(TThread)
private
ClientSocket : TCustomWinSocket;
procedure EXecute; override;
end;

type TRecvThread = class(TServerClientThread)
procedure ClientExecute; override;
end;

//这里是CLIENT端（一般都是发送方）
procedure TSendThread.Execute;
var
FileBuffer : Array [0..FileBufferSize-1] of byte;
FileToSend : file of byte;
ReadNumber : integer;
theStream : TWinSocketStream;
begin
theStream := TWinSocketStream.Create(ClientSocket,120000);
AssignFile(FileToSend,'d:/abc.zip');
Reset(FileToSend);

while (not Terminated) and (ClientSocket.Connected) do begin
BlockRead(FileToSend,FileBuffer,FileBufferSize,ReadNumber); //读1024字节
if ReadNumber>0 then
theStream.Write(FileBuffer,ReadNumber); //发1024字节
if (ReadNumber=0) or (ReadNumber<>FileBufferSize) then break; //文件读完，退出
end;

CloseFile(FileToSend);
theStream.Free;
ClientSocket.Close;
end;


//这里是SERVER端（一般都是接收方）
procedure TRecvThread.ClientExecute;
var
FileBuffer : Array [0..FileBufferSize-1] of byte;
FileHandle : Integer;
ReadNumber : integer;
theStream : TWinSocketStream;
begin
theStream := TWinSocketStream.Create(ClientSocket,120000);
FileHandle:=FileCreate('d:/abc.zip');

while (not Terminated) and (ClientSocket.Connected) do begin
if theStream.WaitForData(10) then begin
try
theStream.Read(FileBuffer,ReadNumber); //接收数据流
if ReadNumber<>0 then
FileWrite(FileHandle,FileBuffer,ReadNumber); //写入文件
else
Terminate; //对方关闭连接，传输完毕。线程结束
end；
except
Terminate; //传输出错，线程结束
end;
end;
end;

FileClose(FileHandle);
theStream.Free;
ClientSocket.Close;
end;

当客户端要传输文件时，先连接入服务端，而服务端就会启动一接收线程准备接收。然后，客户端就可用TSendThread.Create来启动传输线程进入传输了。
当然，这里只给出了文件的传输和接收部分，好多差错检测以及传输之前的连接、文件信息的交换就由大家处理啦！比较简单，但代码会不少！
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

L
关于一个多线程分割下载文件的问题,请帮我看看,谢谢! 200分(100)
回复
4
查看
826
lzp_xiaoxian
L
B
那位高手帮我看看这个socket多线程 服务器 的问题..... ( 积分: 200 )
回复
10
查看
581
baiduan
B
K
多线程关于线程退出的问题。(100分)
回复
4
查看
755
kernelj
K
8
高手进来啊... 帮忙看看那里错了.在线等待.. ( 积分: 50 )
回复
2
查看
226
866521
8
C
关于delphi的 serversocket 动态创建，并监听多个端口的问题 ( 积分: 100 )
回复
0
查看
210
cnmir
C
后退
顶部