solution.txt

在Midas数据库编程中

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
[e-mail]