谁用过dxsocket?(200分)

  • 主题发起人 主题发起人 jingtao
  • 开始时间 开始时间
J

jingtao

Unregistered / Unconfirmed
GUEST, unregistred user!
我使用那个TDXServerCore,同时,当客户端连接上来后,我想把这个客户端socket保存到list,以供后面使用,应该怎么干?
 
不是吧,这也200分?TDXServerCore现在没用,客户端socket还是服务器端这个客户连接的socket?
前者需要客户端发给你,不过好象没什么用处,估计你要后者吧?如果没有属性是指向这个数据的,那么看看源代码吧,它可能是一个私有的属性,你继承一个开放一下就是了
 
我的分太多了..
是这样的,当有新连接的时候,应该会触发
procedure TForm1.DXServerCore1NewConnect( ClientThread: TDXClientThread);
我在这里直接发送数据给Client端是OK的,但是,如果我把这个ClientThread保存到指针列表,方便在其它地方往客户端发送数据,结果失败了.总是提示该socket已经死了.但实际上我的客户端是长连接的SOCKET
 
明白你的意思。你是想保存客户端的IP和连接端口吧,给你一个关于idtcpserver的demo.
和你需要的应用应该是一致的。使用这样的方式维护客户端信息不错。(程序是indy的demo,不是我写的,只是最近我在看。)
需要说明的是,如果你使用这样的方式,客户端连接到服务端以后,连接是不能断开的,否则不能从服务端把信息发回去。
另外,我最近使用idupdserver,两端都使用idupdserver,这样可以很好的处理你的问题。


{-----------------------------------------------------------------------------
Demo Name: ServerFrmMainUnit
Author: Helge Jung (helge@eco-logic-software.de)
Copyright: Indy Pit Crew
Purpose:
History: Improvements supplied by: Enver ALTIN
Date: 27/10/2002 00:23:25
Checked with Indy version: 9.0 - Allen O'Neill - Springboard Technologies Ltd - http://www.springboardtechnologies.com
-----------------------------------------------------------------------------
Notes:

Demonstration on how to use TIdTCPServer and TIdTCPClient
with using Threads and WriteBuffer/ReadBuffer

}

unit ServerFrmMainUnit;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
StdCtrls,IdTCPServer,IdThreadMgr,IdThreadMgrDefault,IdBaseComponent,
IdComponent;

type
PClient=^TClient;
TClient=record // Object holding data of client (see events)
DNS:string[20]; { Hostname }
Connected, { Time of connect }
LastAction:TDateTime; { Time of last transaction }
Thread:Pointer; { Pointer to thread }
end;

TServerFrmMain=class(TForm)
Server:TIdTCPServer;
CBServerActive:TCheckBox;
Protocol:TMemo;
IdThreadMgrDefault1:TIdThreadMgrDefault;

procedure CBServerActiveClick(Sender:TObject);
procedure ServerConnect(AThread:TIdPeerThread);
procedure ServerExecute(AThread:TIdPeerThread);
procedure ServerDisconnect(AThread:TIdPeerThread);
procedure FormCreate(Sender:TObject);
procedure FormClose(Sender:TObject; var Action:TCloseAction);

private

public
end;

var
ServerFrmMain:TServerFrmMain;
Clients:TThreadList; // Holds the data of all clients

implementation

uses GlobalUnit;

{$R *.DFM}

procedure TServerFrmMain.CBServerActiveClick(Sender:TObject);
begin
Server.Active:=CBServerActive.Checked;
end;

procedure TServerFrmMain.ServerConnect(AThread:TIdPeerThread);
var
NewClient:PClient;

begin
GetMem(NewClient,SizeOf(TClient));

NewClient.DNS:=AThread.Connection.LocalName;
NewClient.Connected:=Now;
NewClient.LastAction:=NewClient.Connected;
NewClient.Thread:=AThread;

AThread.Data:=TObject(NewClient);

try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

Protocol.Lines.Add(TimeToStr(Time)+' Connection from "'+NewClient.DNS+'"');
end;

procedure TServerFrmMain.ServerExecute(AThread:TIdPeerThread);
var
ActClient,RecClient:PClient;
CommBlock,NewCommBlock:TCommBlock;
RecThread:TIdPeerThread;
i:Integer;

begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
AThread.Connection.ReadBuffer(CommBlock,SizeOf(CommBlock));
ActClient:=PClient(AThread.Data);
ActClient.LastAction:=Now; // update the time of last action

if (CommBlock.Command='MESSAGE')or(CommBlock.Command='DIALOG') then
begin // 'MESSAGE': A message was send - forward or broadcast it
// 'DIALOG': A dialog-window shall popup on the recipient's screen
// it's the same code for both commands...

if CommBlock.ReceiverName='' then
begin // no recipient given - broadcast
Protocol.Lines.Add(TimeToStr(Time)+' Broadcasting '+CommBlock.Command+': "'+CommBlock.Msg+'"');
NewCommBlock:=CommBlock; // nothing to change ;-))

with Clients.LockList do
try
for i:=0 to Count-1 do // iterate through client-list
begin
RecClient:=Items; // get client-object
RecThread:=RecClient.Thread; // get client-thread out of it
RecThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True); // send the stuff
end;
finally
Clients.UnlockList;
end;
end
else
begin // receiver given - search him and send it to him
NewCommBlock:=CommBlock; // again: nothing to change ;-))
Protocol.Lines.Add(TimeToStr(Time)+' Sending '+CommBlock.Command+' to "'+CommBlock.ReceiverName+'": "'+CommBlock.Msg+'"');
with Clients.LockList do
try
for i:=0 to Count-1 do
begin
RecClient:=Items;
if RecClient.DNS=CommBlock.ReceiverName then // we don't have a login function so we have to use the DNS (Hostname)
begin
RecThread:=RecClient.Thread;
RecThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True);
end;
end;
finally
Clients.UnlockList;
end;
end;
end
else
begin // unknown command given
Protocol.Lines.Add(TimeToStr(Time)+' Unknown command from "'+CommBlock.MyUserName+'": '+CommBlock.Command);
NewCommBlock.Command:='DIALOG'; // the message should popup on the client's screen
NewCommBlock.MyUserName:='[Server]'; // the server's username
NewCommBlock.Msg:='I don''t understand your command: "'+CommBlock.Command+'"'; // the message to show
NewCommBlock.ReceiverName:='[return-to-sender]'; // unnecessary

AThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True); // and there it goes...
end;
end;
end;

procedure TServerFrmMain.ServerDisconnect(AThread:TIdPeerThread);
var
ActClient:PClient;

begin
ActClient:=PClient(AThread.Data);
Protocol.Lines.Add(TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data:=nil;
end;

procedure TServerFrmMain.FormCreate(Sender:TObject);
begin
Clients:=TThreadList.Create;
end;

procedure TServerFrmMain.FormClose(Sender:TObject; var Action:TCloseAction);
begin
Server.Active:=False;
Clients.Free;
end;

end.
 
Indy太烂了.不能适应我的要求.因为它的WriteBuffer和ReadBuffer需要用到中间流对象,结果效率非常差.如果你修改一下它的代码,可以提升至少10倍的传输速度.不过它用流也是有道理的,例如,如果你第一次接收数据,字节为10.但是客户端发送了两次例如18个字节.那么另外8个会放到缓冲流供你下次读取.
总之,它的速度不适合我.
 
你修改一下indy的代码试验一下就知道了
function TIdTCPConnection.ReadFromStackNow(ABuffer: Pointer;
const ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer;
const ARaiseExceptionOnTimeout: Boolean): Integer;
// Reads any data in tcp/ip buffer and puts it into Indy buffer
// This must be the ONLY raw read from Winsock routine
// This must be the ONLY call to RECV - all data goes thru this method
var
i: Integer;
LByteCount: Integer;
begin
if ATimeout = IdTimeoutDefault then
begin
if ReadTimeOut = 0 then
begin
ATimeout := IdTimeoutInfinite;
end
else
begin
ATimeout := FReadTimeout;
end;
end;

Result := 0;
// Check here as this side may have closed the socket
CheckForDisconnect(ARaiseExceptionIfDisconnected);
if Connected then
begin
LByteCount := 0;
repeat
if IOHandler.Readable(ATimeout) then
begin
if Assigned(IOHandler) then
begin //APR: disconnect from other thread
// No need to call AntiFreeze, the Readable does that.
LByteCount := IOHandler.Recv(Pointer(Pchar(ABuffer)+FRecvBufferNowSize)^, RecvBufferSize);
end
else
begin
LByteCount := 0;
if ARaiseExceptionIfDisconnected then raise EIdNotConnected.Create(RSNotConnected);
end;
FClosedGracefully := LByteCount = 0;
if not ClosedGracefully then
begin
if GStack.CheckForSocketError(LByteCount, [Id_WSAESHUTDOWN, Id_WSAECONNABORTED]) then
begin
LByteCount := 0;
DisconnectSocket;
// Do not raise unless all data has been read by the user
if InputBuffer.Size = 0 then
begin
GStack.RaiseSocketError(GStack.LastError);
end;
end;
// InputBuffer.Size is modified above
if LByteCount > 0 then
begin
Inc(FRecvBufferNowSize,LByteCount);
end;
end;
// Check here as other side may have closed connection
CheckForDisconnect(ARaiseExceptionIfDisconnected);
Result := LByteCount;
end
else
begin
// Timeout
if ARaiseExceptionOnTimeout then
begin
raise EIdReadTimeout.Create(RSReadTimeout);
end;
Result := -1;
Break;
end;
until (LByteCount <> 0) or (Connected = False);
end
else
begin
if ARaiseExceptionIfDisconnected then
begin
raise EIdNotConnected.Create(RSNotConnected);
end;
end;
end;

至少快10倍
 
见者有份..快进来啊....DFW最后一个贴.MD
 
专业路过
 
抢分..........
 
jingtao咋了?
 
多人接受答案了。
 
经滔兄能否把 突破还原精灵自动转存代码发我一份,以前你在网站上面 公布转存代码的。 硬盘坏了数据丢了,经滔兄看见回答下小弟
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3521736
 
后退
顶部