Borland Socket Server程序 包含D6和D7源码

Hi Dan: After 6 month I response your ask for my tips in this enviroments, more I have the fix. I get the fix today after 15 day in January to detect and 30 hs in the last two day searching the solution because the problem become more frequently in machine with high processor (Dell 2400 dual) I need talk with you and I need if you can contact peope arround the broalnd world to test this fix. My preliminary testing was successfully Maybe Borland wants hire to me :). Ok, go ahead! The first problem I post to raid and is open number 139350 , this problem affect with have a lot of thread! your client application died and you remain objects in socket server. My fix this raid work fine 2nd and 3th I found doing sniffers and extreme logs. The point is server and client are in listen point at the same time, If you disconnect from socket the client returns!. This is the failure, well this failures is produce by: Second problem I think but I'm not sure is in function TCustomWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer; i'm not sure because I haven't time to try don't use this fix. My point was, using this fix work, so keep there! The new code is see {##Add}: function TCustomWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer; var ErrorCode, iCount: Integer; {##Add} begin Lock; try Result := 0; if (Count = -1) and FConnected then ioctlsocket(FSocket, FIONREAD, Longint(Result)) else begin if not FConnected then Exit; if ioctlsocket(FSocket, FIONREAD, iCount) = 0 then {##ADD} begin if iCount < Count then {##ADD} Count := icount; {##ADD} end; Result := recv(FSocket, Buf, Count, 0); if Result = SOCKET_ERROR then begin ErrorCode := WSAGetLastError; if ErrorCode <> WSAEWOULDBLOCK then begin Error(Self, eeReceive, ErrorCode); Disconnect(FSocket); if ErrorCode <> 0 then raise ESocketError.CreateResFmt(@sWindowsSocketError, [SysErrorMessage(ErrorCode), ErrorCode, 'recv']); end; end; end; finally Unlock; end; end; Thrird Problem THE PROBLEM! I think this the point !:.... function TSocketTransport.Receive(WaitForInput: Boolean; Context: Integer): IDataBlock; this function read when it want , but this function woukd be reading when WINSOCK want! the problem is wait for the event the new code is : (see {##ADD} function TSocketTransport.Receive(WaitForInput: Boolean; Context: Integer): IDataBlock; var RetLen, Sig, StreamLen: Integer; P: Pointer; FDSet: TFDSet; TimeVal: PTimeVal; RetVal: Integer; bFirst: boolean; {## ADD} begin Result := nil; TimeVal := nil; FD_ZERO(FDSet); FD_SET(FSocket.SocketHandle, FDSet); if not WaitForInput then begin New(TimeVal); TimeVal.tv_sec := 0; TimeVal.tv_usec := 1; end; RetVal := select(0, @FDSet, nil, nil, TimeVal); if Assigned(TimeVal) then FreeMem(TimeVal); if RetVal = SOCKET_ERROR then raise ESocketConnectionError.Create(SysErrorMessage(WSAGetLastError)); if (RetVal = 0) then Exit; RetLen := FSocket.ReceiveBuf(Sig, SizeOf(Sig)); if RetLen <> SizeOf(Sig) then raise ESocketConnectionError.CreateRes(@SSocketReadError); CheckSignature(Sig); RetLen := FSocket.ReceiveBuf(StreamLen, SizeOf(StreamLen)); if RetLen = 0 then raise ESocketConnectionError.CreateRes(@SSocketReadError); if RetLen <> SizeOf(StreamLen) then raise ESocketConnectionError.CreateRes(@SSocketReadError); Result := TDataBlock.Create as IDataBlock; Result.Size := StreamLen; Result.Signature := Sig; P := Result.Memory; Inc(Integer(P), Result.BytesReserved); {this next line is for safety , because I detect one case where the code can't not read the first time, 60000 is tentative, maybe INFINITE is correct} if (StreamLen > 0) then WaitForSingleObject(FEvent, 60000);{##Add} bFirst := True; {##ADD} {this line maybe I can don't use , but I keep it because the same case in first time} while StreamLen > 0 do begin RetLen := FSocket.ReceiveBuf(P^, StreamLen); if RetLen = 0 then begin {##Add} if not bFirst then {##ADD} {this is because If you retry you get the correct data!!} raise ESocketConnectionError.CreateRes(@SSocketReadError); bFirst := False; {##ADD} end; if RetLen > 0 then begin Dec(StreamLen, RetLen); Inc(Integer(P), RetLen); end; {##ADD} {This is the CODE this the more important part of the fix} if StreamLen > 0 then {Only when you need mare than one recv, i fyou put this code before reveivebuf you are an step delayed and the connection don't close or has many time to read , because WSAResetEvent(FEvent) in caller function!} begin if (WaitForSingleObject(FEvent, 90000) = WAIT_OBJECT_0) then {I wait for read, maybe you can change 90000 with INFINITE} begin WSAResetEvent(FEvent);{I reset the event, very important because Wait don't work} end else begin raise ESocketConnectionError.Create('Read Error Single Object Timeout'); end; end; {##END ADD} end; if StreamLen <> 0 then raise ESocketConnectionError.CreateRes(@SInvalidDataPacket); InterceptIncoming(Result); end; Manuel Parma mparma@usa.net