程
程云
Unregistered / Unconfirmed
GUEST, unregistred user!
Borland Socket Server在通过Internet联接时,很有问题,有没有替代品?
我在作三层结构时,有一部分需要通过Internet来连接,是走的Borland Socket Server
(scktsrvr.exe)。
但这个程序很有问题,有的用户连接上之后,这个程序就会站用大量的CPU时间,
而这个用户在断了连接之后,在Borland Socket Server是还存在这个连接,
而且,还是占用大量的CPU时间(90%以上)。
这使的服务器根本无法作其它的操作。
现在已无法改成其它结构。
唯一可行的方法,只有另找一个Borland Socket Server的替代品,
要不就想办法修改它其中的代码。
相关代码片段如下。
procedure TSocketDispatcherThread.ClientExecute;
var
Data: IDataBlock;
msg: TMsg;
Obj: ISendDataBlock;
Event: THandle;
WaitTime: DWord;
begin
CoInitialize(nil);
try
Synchronize(AddClient);
FTransport := CreateServerTransport;
try
Event := FTransport.GetWaitEvent;
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
GetInterface(ISendDataBlock, Obj);
if FRegisteredOnly then
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, '');
try
Obj := nil;
if FTimeout = 0 then
WaitTime := INFINITE else
WaitTime := 60000;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
WAIT_OBJECT_0:
begin
WSAResetEvent(Event);
*******************************************
Data := FTransport.Receive(False, 0); 在客户端断开连接时,这里总是出错。
*******************************************
if Assigned(Data) then
begin
FLastActivity := Now;
FInterpreter.InterpretData(Data);
Data := nil;
FLastActivity := Now;
end;
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
DispatchMessage(msg);
WAIT_TIMEOUT:
if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
FTransport.Connected := False;
end;
except
FTransport.Connected := False;
end;
finally
FInterpreter.Free;
FInterpreter := nil;
end;
finally
FTransport := nil;
end;
finally
CoUninitialize;
Synchronize(RemoveClient);
end;
end;
我在作三层结构时,有一部分需要通过Internet来连接,是走的Borland Socket Server
(scktsrvr.exe)。
但这个程序很有问题,有的用户连接上之后,这个程序就会站用大量的CPU时间,
而这个用户在断了连接之后,在Borland Socket Server是还存在这个连接,
而且,还是占用大量的CPU时间(90%以上)。
这使的服务器根本无法作其它的操作。
现在已无法改成其它结构。
唯一可行的方法,只有另找一个Borland Socket Server的替代品,
要不就想办法修改它其中的代码。
相关代码片段如下。
procedure TSocketDispatcherThread.ClientExecute;
var
Data: IDataBlock;
msg: TMsg;
Obj: ISendDataBlock;
Event: THandle;
WaitTime: DWord;
begin
CoInitialize(nil);
try
Synchronize(AddClient);
FTransport := CreateServerTransport;
try
Event := FTransport.GetWaitEvent;
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
GetInterface(ISendDataBlock, Obj);
if FRegisteredOnly then
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, '');
try
Obj := nil;
if FTimeout = 0 then
WaitTime := INFINITE else
WaitTime := 60000;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
WAIT_OBJECT_0:
begin
WSAResetEvent(Event);
*******************************************
Data := FTransport.Receive(False, 0); 在客户端断开连接时,这里总是出错。
*******************************************
if Assigned(Data) then
begin
FLastActivity := Now;
FInterpreter.InterpretData(Data);
Data := nil;
FLastActivity := Now;
end;
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
DispatchMessage(msg);
WAIT_TIMEOUT:
if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
FTransport.Connected := False;
end;
except
FTransport.Connected := False;
end;
finally
FInterpreter.Free;
FInterpreter := nil;
end;
finally
FTransport := nil;
end;
finally
CoUninitialize;
Synchronize(RemoveClient);
end;
end;