Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 774
  • Last Modified:

URGENT! blocking socket NOT firing OnDisconnect in Delphi 5

Has anyone used blocking socket in Delphi5? I have following problem:
When connection with server/network connection is dropped, OnDisconnect event is not fired.

What am I doing wrong?

Points can be up to 1000 * A grade = 4000 expert points!!!

Code follows:
0
Zlatin Zlatev
Asked:
Zlatin Zlatev
  • 6
  • 3
1 Solution
 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
procedure TMainForm.SocketCycle;
Var
  SockStream: TWinSocketStream;
  Cmd: String;
  Buffer: Array [0..4096] of Char;
  StringBuffer: String;
  Index: Integer;
  Len: Integer;

begin
  SockStream := nil;
  try
    MainSocket.Open;

    If MainSocket.Active Then Begin
      ExitFlag := False;
      SockStream := TWinSocketStream.Create(MainSocket.Socket, 2000);
      ShouldSend := False;
      While Not ExitFlag Do Begin
        While (Not SockStream.WaitForData(100)) And (Not ExitFlag) And (Not ShouldSend) And MainSocket.Active Do
          Application.ProcessMessages;
        ExitFlag := ExitFlag or (NOT MainSocket.Active);
        ShouldSend := False;
        If Not ExitFlag then Begin
          If SockStream.WaitForData(100) Then Begin
            Len := SizeOf(Buffer);
            Cmd := '';
            While Len = SizeOf(Buffer) Do Begin
              Len := SockStream.Read(Buffer, Len);
              StringBuffer := Buffer;
              StringBuffer := Copy(StringBuffer, 1, Len);
              Cmd := Cmd + StringBuffer;
              Application.ProcessMessages;
             End;
            If Length(Cmd)>0 Then Begin
              Self.DoLog('<'+IntToStr(Length(Cmd))+'<'+Cmd);
              RecvQueue.Items.Add(Cmd);
              Self.SocketRecieve;
            End;
          End;
          While SendQueue.Items.Count > 0 Do Begin
            Cmd := SendQueue.Items[0];
            FillChar(Buffer, SizeOf(Buffer), 0);
            For Index := 1 To Length(Cmd) Do Buffer[Index] := Cmd[Index];
            SockStream.WriteBuffer(Buffer, Length(Cmd)+1);
            Self.DoLog('>'+IntToStr(Length(Cmd))+'>'+Cmd);
            SendQueue.Items.Delete(0);
            If SockStream.WaitForData(100) Then Begin
              ShouldSend := True;
              Break;
            End;
          End;
        End;
      End;
    End;
  except
    ExitFlag := True;
  end;
  SockStream.Free;
  MainSocket.Close;
end;

procedure TMainForm.MainSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ExitFlag:=True;
  Self.SocketOnDisconnectExecute(Sender);
end;

procedure TMainForm.SocketOnDisconnectExecute(Sender: TObject);
begin
  If AccidentalDisconnect Then Begin
    Self.IsLogged := False;
    MessageDlg('Accidental Disconnect!', mtError, [mbOK], 0);
    Self.ResetConnection;
  End;
end;
0
 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
RecvQueue and SendQueue are hidden listboxes on the form.

ShouldSend is made true when data is added to SendQueue.
ExitFlag is made true when application should be terminated.
AccidentalDiscconect is true at any time disconnect is not supposed to happen. (made false when ExitFlag is true or user chooses to disconnect from server)

IsLogged is property on the form specifyng whether user has successfully logged in.

ResetConnection method resets properties and variables relative to socket connection.
DoLog method is for purposes of making log of the socket connection.

MainSocket is TClientSocket with ClientType = ctBlocking on the MainForm.
0
 
mocartsCommented:
I think you should use OnError and check for WSAECONNRESET or WSAECONNABORTED ErrorCode as it is an error if server dropped connection.
see more socket error codes at http://msdn.microsoft.com/library/en-us/winsock/winsock/windows_sockets_error_codes_2.asp
wbr, mo.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
Tested this with no success - OnError is not fired in TClientSocket, even if I remove the network cable from my machine.
btw. I am testing on Windows 98 SE.
0
 
mocartsCommented:
if this is still actual..
try this code:

procedure TMainForm.SocketCycle;
Var
 SockStream: TWinSocketStream;
 Cmd: String;
 Buffer: Array [0..4096] of Char;
 StringBuffer: String;
 Index: Integer;
 Len: Integer;
// for disconnect checking
 DataReadyFlag: boolean;

begin
 SockStream := nil;
 try
   MainSocket.Open;
   If MainSocket.Active Then Begin
     ExitFlag := False;
     SockStream := TWinSocketStream.Create(MainSocket.Socket, 2000);
     ShouldSend := False;
     While Not ExitFlag Do Begin
       While (Not SockStream.WaitForData(100)) And (Not ExitFlag) And (Not ShouldSend) And MainSocket.Active Do
         Application.ProcessMessages;
       ExitFlag := ExitFlag or (NOT MainSocket.Active);
       ShouldSend := False;
       If Not ExitFlag then Begin
         DataReadyFlag := SockStream.WaitForData(100);
         if DataReadyFlag Then Begin
           Len := SizeOf(Buffer);
           Cmd := '';
           While Len = SizeOf(Buffer) Do Begin
             Len := SockStream.Read(Buffer, Len);

             // checking for disconnect
             if DataReadyFlag then
               //
               if (Len = 0) then
               begin
                 // Disconnected
                 AccidentalDisconnect := True;
                 SocketOnDisconnectExecute(MainSocket);
                 exitFlag := True;
                 break;
               end else
                 // Data received - clear the flag
                 DataReadyFlag := False;

             StringBuffer := Buffer;
             StringBuffer := Copy(StringBuffer, 1, Len);
             Cmd := Cmd + StringBuffer;
             Application.ProcessMessages;
            End;
           If Length(Cmd)>0 Then Begin
             Self.DoLog('<'+IntToStr(Length(Cmd))+'<'+Cmd);
             RecvQueue.Items.Add(Cmd);
             Self.SocketRecieve;
           End;
         End;
         While SendQueue.Items.Count > 0 Do Begin
           Cmd := SendQueue.Items[0];
           FillChar(Buffer, SizeOf(Buffer), 0);
           For Index := 1 To Length(Cmd) Do Buffer[Index] := Cmd[Index];
           SockStream.WriteBuffer(Buffer, Length(Cmd)+1);
           Self.DoLog('>'+IntToStr(Length(Cmd))+'>'+Cmd);
           SendQueue.Items.Delete(0);
           If SockStream.WaitForData(100) Then Begin
             ShouldSend := True;
             Break;
           End;
         End;
       End;
     End;
   End;
 except
   ExitFlag := True;
 end;
 SockStream.Free;
 MainSocket.Close;
end;

main idea is in fact that WaitForData returns true if socket is ready for reading, but if disconnect occurs then SockStream.Read(..) returns zero read bytes what normally doesn't occurs.
in case when socket has blocking state it doesn't receive a messages.. (including FD_CLOSE :( )
another way is to use some other components which is implemented better (indy for example) In Delphi 7 you don't find such TClientSocket and TServerSocket components...

good luck and I hope this helps!
wbr, mo.
0
 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
Thanks A LOT!!! Yoy've saved my à$$ < grim >

I have one more question - what we have in Delphi7 instead of this comonents?

The code I use do not need DataReadyFlag flag, see bellow:
0
 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
procedure TMainForm.SocketCycle;
Var
  SockStream: TWinSocketStream;
  Cmd: String;
  Buffer: Array [0..4096] of Char;
  StringBuffer: String;
  Index: Integer;
  Len: Integer;

begin
  SockStream := nil;
  try
    MainSocket.Open;

    If MainSocket.Active Then Begin
      ExitFlag := False;
      SockStream := TWinSocketStream.Create(MainSocket.Socket, 2000);
      ShouldSend := False;
      While Not ExitFlag Do Begin
        While (Not SockStream.WaitForData(100)) And (Not ExitFlag) And (Not ShouldSend) And MainSocket.Active Do
          Application.ProcessMessages;
        ExitFlag := ExitFlag or (NOT MainSocket.Active);
        ShouldSend := False;
        If Not ExitFlag then Begin
          If SockStream.WaitForData(100) Then Begin
            Len := SizeOf(Buffer);
            Cmd := '';
            While Len = SizeOf(Buffer) Do Begin
              Len := SockStream.Read(Buffer, Len);
              StringBuffer := Buffer;
              StringBuffer := Copy(StringBuffer, 1, Len);
              Cmd := Cmd + StringBuffer;
              Application.ProcessMessages;
             End;
            If Length(Cmd)>0 Then Begin
              Self.DoLog('<'+IntToStr(Length(Cmd))+'<'+Cmd);
              RecvQueue.Items.Add(Cmd);
              Self.SocketRecieve;
            End Else Begin //Recieved zero-length response - disconnect *ADDED*
              AccidentalDisconnect := True;
              SocketOnDisconnectExecute(MainSocket);
              exitFlag := True;
              break;
            End;
          End;
          While SendQueue.Items.Count > 0 Do Begin
            Cmd := SendQueue.Items[0];
            FillChar(Buffer, SizeOf(Buffer), 0);
            For Index := 1 To Length(Cmd) Do Buffer[Index] := Cmd[Index];
            SockStream.WriteBuffer(Buffer, Length(Cmd)+1);
            Self.DoLog('>'+IntToStr(Length(Cmd))+'>'+Cmd);
            SendQueue.Items.Delete(0);
            If SockStream.WaitForData(100) Then Begin
              ShouldSend := True;
              Break;
            End;
          End;
        End;
      End;
    End;
  except
    ExitFlag := True;
  end;
  SockStream.Free;
  MainSocket.Close;
end;
0
 
mocartsCommented:
Delphi 6 introduces TtcpClient and TtcpServer based on WinSock2 since WinSock2 supports multiple interfaces like TCP, UDP, SPX etc. (TClientSocket and TServerSocket implements and uses only WinSock 1 and only TCP).

wbr, mo.
0
 
Zlatin ZlatevTechnical ArchitectAuthor Commented:
OK. Thanks for the info.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now