TClient/ServerSocket - Daten kommen nicht an.

[thkerkmann]

Also, auf vielfachen Wunsch hier der Code....

Delphi-Quellcode:

// Verbindung aufnehmen - wird durch einen Timer geprüft und evtl. aufgerufen.
procedure TdmCommunication.ReconnectVQDB;
begin
  VQDBSocket.Host := 'localhost';
  VQDBSocket.Port := VQDB_port; //
  VQDBconnected := _connecting_;
  VQDBSocket.Open;
end;

// Ereignis Connect eingetreten.
// Es wird eine Registrierung an die Serveranwendung gesendet.
procedure TdmCommunication.VQDBSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  VQDBConnected := _connected_;
  Socket.SendText('PT|CM$$|RIDB,RE' + eorec);
  Logout('[VQDB] connected.');
  // set keep alive option
  if setsockopt(Socket.SocketHandle, SOL_SOCKET, SO_KEEPALIVE,
    @bOptVal, bOptLen) = SOCKET_ERROR then
    Logout('Error, can not set socket options. ' +
      SysErrorMessage(WSAGetLastError()));
end;

// Ereignis Disconnet eingetreten. Timer wird den Connect wieder einleiten.
procedure TdmCommunication.VQDBSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  VQDBConnected := _disconnected_;
  Logout('[VQDB] disconnected.');
end;

// Error aufgetreten - Timer wird den Connect wieder einleiten.
procedure TdmCommunication.VQDBSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  VQDBSocket.Close;
  VQDBConnected := _disconnected_;
  LogOut('[VQDB] socket error ' + IntToStr(ErrorCode) + ' ' +
    SysErrorMessage(ErrorCode));
  Errorcode := 0;
end;

// Daten lesen und an den Buffer anhängen.
// Es wird für die Lesende Task ein Ereignis ausgelöst zum abholen der Daten.
procedure TdmCommunication.VQDBSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: string;
begin
  s := '';
  while Socket.ReceiveLength > 0 do
    s := s + Socket.ReceiveText;

  if Assigned(FOnVQDBDataAvailable) then
  begin
    FVQDBBuffer := FVQDBBuffer + s;
    FOnVQDBDataAvailable(self, length(FVQDBBuffer));
  end
  else
    Logout('discarded: ' + s);
end;

Dies ist mein standard Paket für einen Client-Socket. Es funktioniert sehr gut. Es ist ja nicht so, dass ich einen grundsätlichen Fehler habe, sondern das Problem zeigt sich nur auf bestimmten System - und zwar solchen, die relativ viel IP Kommunikation betreiben.

Jetzt zum Servercode

Delphi-Quellcode:

// Ein Client hat sich verbunden - Es wird zunächst nur die KEEPALIVE option gesetzt
// weiteres geschieht im OnRead
procedure TdmCommunication.ListenSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  // set keep alive option
  if setsockopt(Socket.SocketHandle, SOL_SOCKET, SO_KEEPALIVE,
    @bOptVal, bOptLen) = SOCKET_ERROR then
    Logout('Error, can not set socket options. ' +
      SysErrorMessage(WSAGetLastError()));
end;

// Client disconnected
// DeleteClient löscht den Client aus der Verwaltungsliste.
procedure TdmCommunication.ListenSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  DeleteClient(Socket);
end;

// Daten vom Client angekommen.
// Registrierung wird erkannt und dann in die Verwaltung eingereiht.
// Wenn keine Registrierung dann werden die Daten in die Warteschlange gegeben.
procedure TdmCommunication.ListenSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: string;
begin
  s := '';
  while Socket.ReceiveLength > 0 do
    s := s + Socket.ReceiveText;

  if CommSubStr(s, '|CM') = '$$' then // Anmeldung
    RegisterClient(Socket, s)
  else
  begin
    Logout('[Listen]: ' + TranslateCtrlChars(s));

    if Assigned(FOnListenDataAvailable) then
    begin
      FListenBuffer := FListenBuffer + s;
      FOnListenDataAvailable(self, length(FListenBuffer));
    end
    else
      Logout('discarded: ' + s);
  end;
end;

// Client error aufgetreten - Der Socket wird geschlossen...
// Der Client wird aus der Verwaltung gelöscht.
procedure TdmCommunication.ListenSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  DeleteClient(Socket);

  LogOut('[Listen] socket error ' + IntToStr(ErrorCode) + ' ' +
    SysErrorMessage(ErrorCode));
  ErrorCode := 0;
end;

// Löschen eines Client aus der Registrierungsliste.
procedure TdmCommunication.DeleteClient(Socket: tCustomWinSocket);
var
  i: integer;
  cs: tClientSession;
begin
  for i := 0 to Clients.Count - 1 do
  begin
    cs := tClientSession(clients.Objects[i]);
    if cs.Socket = Socket then
    begin
      cs.Free;
      clients.Delete(i);
      break;
    end;
  end;
end;

// Einstellen eines Clients in die Registrierungsliste
procedure TdmCommunication.RegisterClient(Socket: TCustomWinSocket;
  s: string);
var
  aKennung: string;
  aSession: tClientSession;
  i: integer;
begin
  Logout('register client: ' + s);
  aKennung := copy(s, 1, 2);
  i := clients.IndexOf(aKennung);
  if i >= 0 then // schon in der Liste, update recordlist
    with tClientSession(clients.objects[i]) do
      RecordList := CommSubStr(s, '|RI')
  else
  begin
    aSession := tClientSession.Create(Socket, aKennung);
    aSession.RecordList := CommSubStr(s, '|RI');
    Clients.AddObject(aKennung, aSession);
  end;
end;

// Wenn Daten gesendet werden sollen, läuft diese Prozedur über die registrierten Clients,
// prüft ob für diesen Client der zu sendende Datensatz gültig ist,
// und wenn ja sendet die Daten.
function TdmCommunication.SendToRegistered(const s: string): integer;
var
  i: integer;
  cmd: string;
begin
  result := 0;
  cmd := CommsubStr(s, '|CM');
  for i := 0 to clients.Count - 1 do
    with tClientSession(clients.Objects[i]) do
    begin
      if pos(cmd, RecordList) > 0 then
      begin
        Logout('to ' + Kennung + ': ' + s);
        Socket.SendText(s);
        inc(result); // at least one client who did care about
      end;
    end;
end;

Es sind ca 12-14 Programme die mehrfach auf diese Art und Weise kommunizieren. Sporadisch taucht nun der im ersten Post beschriebene Fehler auf - und auch nur auf Systemen einer gewissen Ausstattung.

Jeder Tip willkommen.

Gruss