Проверка существования подключения к Socket Server со стороны клиента

Цитата Fr0sT @ 17.04.13, 10:43

Ага, особенно в realtime приложениях

Особенно в них.

Цитата apprentice @ 17.04.13, 05:49

Отправляю служебные коды дивайся поэтому выглядят чутка дико.

Кстати - неправильно отправляешь. Смотри:

Цитата apprentice @ 17.04.13, 05:49

output.Socket.SendBuf(BufS,14)

При таком раскладе у тебя передастся сам указатель на буфер данных (4 байта) и соседствующий с ним код в пределах 10 байт. Но это, к сожалению не данные, которые ты так аккуратно, байт за байтом загоняешь в массив. Поэтому необходимо делать так:

output.Socket.SendBuf(BufS[1],14)

Разумеешь?

Сообщение отредактировано: medved_68 - 18.04.13, 03:31

Цитата medved_68 @ 18.04.13, 03:30

Кстати - неправильно отправляешь

У него статический массив, так что всё ОК

С массивом все норм дивайс принимает командные коды. А вот где выставляется тайм аут для обработчика ошибок так и не нашел. Единственная функция для проверки готовности сокетов которую я нарыл это function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): LongInt; но она вот не сильно скорее всего захочет сотрудничать с TClientSocket. Так что если Вы знаете как установить тайм-ауту для обработки ошибок TClientSocket буду очень благодарен. Просто проводя тест с таймером и sendBuf сейчас вообще не вызывает событие он OnError когда я физически отключаю питание серверу

unit Unit2;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, WinSock, Sockets, ExtCtrls;
 
Type
  TKpp=class
  private
    TcpClient1: TTcpClient;
    input: TClientSocket;
    output: TClientSocket;
    controller: TClientSocket;
    timer:TTimer;
 
 
   // procedure outputRead(Sender: TObject; Socket: TCustomWinSocket);
   // procedure controllerRead(Sender: TObject; Socket: TCustomWinSocket);
 
  public
    name,sin,s1in,Erro:string;
    procedure Err(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure inputcon(Sender: TObject; Socket: TCustomWinSocket);
    procedure Read(Sender: TObject; Socket: TCustomWinSocket);
    function idtransfer(id:string):string;
    procedure setIPin(s:string);
    procedure setPortin(s:string);
    procedure InActivate(bool:boolean);
    procedure setIPout(s:string);
    procedure setPortout(s:string);
    procedure outActivate(bool:boolean);
    procedure setIPcon(s:string);
    procedure setPortcon(s:string);
    procedure conActivate(bool:boolean);
    procedure CheckIP;
    procedure clienttype(SokName:string; SokType:integer);
    procedure ding(Sender: TObject);
 
 
    constructor create;
    destructor destroy;
 
end;
implementation
  uses unit1, Thread;
{ TKpp }
 
procedure TKpp.conActivate(bool: boolean);
begin
  controller.Active:=bool;
end;
 
constructor TKpp.create;
begin
  timer:=tTimer.Create(nil);
  timer.Interval:=2000;
  timer.OnTimer:=Ding;
  timer.Enabled:=true;
  TcpClient1:=TTcpClient.create(nil);
  input:=TClientSocket.Create(nil);
  input.ClientType:=ctBlocking;
  //input.OnConnect:=inputcon;
  //input.OnRead:=Read;
  output:=TClientSocket.Create(nil);
  output.OnRead:=Read;
  output.OnError:=Err;
  //output.OnConnecting:=tesConn;
 
 
  controller:=TClientSocket.Create(nil);
  controller.OnRead:=Read;
end;
 
destructor TKpp.destroy;
begin
  input.Destroy;
  output.Destroy;
  controller.Destroy;
end;
 
 
function TKpp.idtransfer(id: string): string;
begin
   id:=id;
end;
 
procedure TKpp.InActivate(bool:boolean);
begin
  input.Active:=bool;
end;
 
procedure TKpp.Read(Sender: TObject; Socket: TCustomWinSocket);
var buf:byte;
begin
  if Socket.ReceiveLength<6 then
  begin
    Socket.ReceiveBuf(buf,1);
    sin:=sin+inttostr(buf);
    s1in:=s1in+inttohex(buf,2);
  end;
  if Socket.ReceiveLength=6 then
  begin
      Socket.ReceiveBuf(buf,1);
      sin:='';
      sin:=inttostr(buf);
      s1in:=inttohex(buf,2);
  end;
  if Socket.ReceiveLength=0 then
    Begin
    //idtransfer(sin);
    //idtransfer(input.Socket.ReceiveText);
     form1.id:=sin;
     if sender=input then
        Begin
         showmessage(Name+' âîøîë'+'='+sin);
        end;
     if sender=output then
        Begin
          showmessage(Name+' âûøåë'+'='+sin);
          form1.id:=sin;
          form1.Label2.Caption:=Name+' âûøåë'+'='+sin;
 
        end;
      if sender=controller then
        Begin
          showmessage('Êîíòðîëëåð');
        end;
    end;
 
end;
 
procedure TKpp.outActivate(bool: boolean);
begin
  output.Active:=bool;
end;
 
procedure TKpp.setIPcon(s: string);
begin
  controller.Address:=s;
end;
 
procedure TKpp.setIPin(s: string);
begin
  input.Address:=s;
end;
 
procedure TKpp.setIPout(s: string);
begin
  output.Address:=s;
end;
 
procedure TKpp.setPortcon(s: string);
begin
  controller.Port:=strtoint(s);
end;
 
procedure TKpp.setPortin(s: string);
begin
  input.Port:=strtoint(s);
end;
 
procedure TKpp.setPortout(s: string);
begin
  output.Port:=strtoint(s);
end;
 
 
 
procedure TKpp.inputcon(Sender: TObject; Socket: TCustomWinSocket);
var s:TWinSocketStream;
    buf1:array[1..6] of byte;
    st:string;
    i:integer;
begin
i:=0;
s:=TWinSocketStream.Create(input.Socket,60000);
while not s.WaitForData(100) do
  Begin
    Application.ProcessMessages;
 
  end;
    for i:=1 to s.Read(buf1,6) do
      begin
        st:=st+inttostr(buf1[i]);
      end;
 
showmessage(st);
end;
 
procedure Tkpp.Err(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 
  //errorcode:=0;
  form1.Label1.Caption:='ошибка связи';
  output.Active:=true;
 
end;
 
procedure TKpp.clienttype(SokName:string; SokType: integer);
begin
if (SokName='output')and(SokType=1) then
  output.Socket.ClientType:=ctBlocking;
if (SokName='input')and(SokType=1) then
  input.Socket.ClientType:=ctBlocking;
if (SokName='controller')and(SokType=1) then
  controller.Socket.ClientType:=ctBlocking;
 
end;
 
procedure TKpp.ding(Sender: TObject);
  var bufs:array[1..14] of byte;
 
begin
 
 
  bufS[1]:=30;
  bufS[2]:=5;
  bufS[3]:=5;
  bufS[4]:=0;
  bufS[5]:=0;
  bufS[6]:=0;
  bufS[7]:=0;
  bufS[8]:=0;
  bufS[9]:=0;
  bufS[10]:=0;
  bufS[11]:=0;
  bufS[12]:=0;
  bufS[13]:=0;
  bufS[14]:=0;
  output.Socket.SendBuf(BufS[1],14);
end;
 
end.

Добавлено 18.04.13, 07:28
в коде вместо этого output.Socket.SendBuf(BufS[1],14) вот это output.Socket.SendBuf(BufS,14)

Для таймаута есть несколько способов:
1) Вызывать select с нужным таймаутом - будет блокировать выполнение до истечения таймаута, если сокет не готов
2) В цикле вызывать select с небольшим таймаутом и наращивать счетчик до нужного значения, добавить досрочный выход / обработку сообщений по вкусу
3) setsockopt + SO_RCVTIMEO/SO_SNDTIMEO

Добавлено 18.04.13, 08:01

Цитата apprentice @ 18.04.13, 07:18

но она вот не сильно скорее всего захочет сотрудничать с TClientSocket

TClientSocket - просто обертка над WinAPI, так что бери его Handle и делай все, что захочется

{$EXTERNALSYM SO_SNDTIMEO}
SO_SNDTIMEO = $1005; насколько я понимаю это время в мили секундах по умолчанию.

procedure TKpp.ding(Sender: TObject);
  var bufs:array[1..14] of byte;
    s:TSocket;
    SocketSet: TFDSet;
    Timeout: TTimeVal;
 
begin
  s:=output.Socket.Handle;
  FD_ZERO(SocketSet);
 FD_SET(s, SocketSet);
 Timeout.tv_sec := 5;
 Timeout.tv_usec := 0;
if select(0, @SocketSet, nil, nil, @Timeout) = SOCKET_ERROR then
 begin
  showmessage('Îøèáêà ïðè ïðîâåðêå ãîòîâíîñòè ñîêåòà:  '+ inttostr(WSAGetLastError));
  Exit;
 end;

Добавлено 18.04.13, 08:31
а этот код если я вас правильно понял возвращает ошибку сокет не существует 10038

Добавлено 18.04.13, 08:33
при этом сокет работает

Добавлено 18.04.13, 08:55

getsockopt(S, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
 showmessage(inttostr(val));

Дало значение 0

Все верно, по дефолту это значение и есть 0. setsockopt для изменения опций.

Цитата apprentice @ 18.04.13, 07:18

Просто проводя тест с таймером и sendBuf сейчас вообще не вызывает событие он OnError когда я физически отключаю питание серверу

Так и должно быть. Ты попробуй сделать вот такую последовательность:
1. Отключить сервер от сети при подключенном к нему клиенте.
2. После этого попробовать отправить что-нибудь на сервер.
В этом случае у тебя должно произойти событие ошибки сокета.

Цитата medved_68 @ 18.04.13, 11:19

Цитата apprentice @ 18.04.13, 07:18

Просто проводя тест с таймером и sendBuf сейчас вообще не вызывает событие он OnError когда я физически отключаю питание серверу

Так и должно быть. Ты попробуй сделать вот такую последовательность:
1. Отключить сервер от сети при подключенном к нему клиенте.
2. После этого попробовать отправить что-нибудь на сервер.
В этом случае у тебя должно произойти событие ошибки сокета.

я с Вами абсолютно согласен. Но вот проблема в том что сокет с нами не согласен

Добавлено 18.04.13, 11:36
Может я не правильно понимаю событие ошибка. Вы имеете в виду возбуждение OnError? Если да то его не происходит.

Кто подскажет почему при включенном сокете когда сокет сервер присылает и я отправляю сообщения ему этот код

procedure TKpp.ding(Sender: TObject);
  var bufs:array[1..14] of byte;
    s:TSocket;
    SocketSet: TFDSet;
 // Òàéì-àóò äëÿ ôóíêöèè select
    Timeout: TTimeVal;
    Len,Val:integer;
begin
  //showmessage(inttostr(output.Socket.Handle));
  s:=output.Socket.Handle;
  FD_ZERO(SocketSet);
 FD_SET(s, SocketSet);
 Timeout.tv_sec := 0;
 Timeout.tv_usec := 900;
 Len := SizeOf(Integer);
 Val:=5;
  if select(0, @SocketSet, nil, nil, @Timeout)= SOCKET_ERROR then
    begin
      showmessage('ошибка ' +inttostr(WSAGetLastError));
 
    exit;
    end;

возвращает ошибка 10038 - ?

может ли это быть из-за того что сокет в не блокируемом режиме?

Цитата medved_68 @ 18.04.13, 11:19

Цитата apprentice @ 18.04.13, 07:18

Просто проводя тест с таймером и sendBuf сейчас вообще не вызывает событие он OnError когда я физически отключаю питание серверу

Так и должно быть. Ты попробуй сделать вот такую последовательность:
1. Отключить сервер от сети при подключенном к нему клиенте.
2. После этого попробовать отправить что-нибудь на сервер.
В этом случае у тебя должно произойти событие ошибки сокета.

самое смешное что событие возбуждается после того как я снова включаю дивайс. Тоисть на сколько я понимаю пока дивайс не ответ что произошла ошибка клиент в ступоре.

Цитата apprentice @ 18.04.13, 11:28

Вы имеете в виду возбуждение OnError? Если да то его не происходит.

Т.е при отключенном девайсе (но коннект до этого был установлен) при попытке записи в сокет не возбуждается ошибка, так? А что возвращает операция записи:

Цитата medved_68 @ 18.04.13, 11:19

2. После этого попробовать отправить что-нибудь на сервер.

???

В том то и дело в коде видно что в таймере есть отправка. Но она ничего не возвращает пока я не включу сервак обратно. Как только включаю снова сервер ошибка 10056 по моему вылетает. Но почему при выключенном сервере нет никаких событий? С чем это связано? Тока не надо говорить с кривыми руками я их как раз ровнять пытаюсь

Цитата apprentice @ 18.04.13, 19:40

В том то и дело в коде видно что в таймере есть отправка.

Ты код отправки при выключенном сервере показывай. А потом будем рассуждать, почему "лыжи не едут".

Цитата medved_68 @ 19.04.13, 03:14

Цитата apprentice @ 18.04.13, 19:40

В том то и дело в коде видно что в таймере есть отправка.

Ты код отправки при выключенном сервере показывай. А потом будем рассуждать, почему "лыжи не едут".

ну как бы вот код в таймере

procedure TKpp.ding(Sender: TObject);
  var bufs:array[1..14] of byte;
    s:TSocket;
    SocketSet: TFDSet;
 // Òàéì-àóò äëÿ ôóíêöèè select
    Timeout: TTimeVal;
    Len,Val:integer;
begin
 
  //showmessage(inttostr(output.Socket.Handle));
 s:=output.Socket.Handle;
 FD_ZERO(SocketSet);
 FD_SET(s, SocketSet);
 Timeout.tv_sec := 0;
 Timeout.tv_usec := 50;
 Len := SizeOf(Integer);
 Val:=50;
 setsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
// getsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
 getsockopt(s, SOL_SOCKET, SO_RCVTIMEO, @Val, Len);
 getsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
 //showmessage(inttostr(val));
 
//if WSAAsyncSelect(S, form1.Handle, WM_USER+1, FD_READ or FD_WRITE)= SOCKET_ERROR then
 
  if select(0, @SocketSet, nil, nil, @Timeout)= SOCKET_ERROR then
    begin
      showmessage('îøèáêà ' +inttostr(WSAGetLastError));
 
    exit;
    end;
 
 
  bufS[1]:=30;
  bufS[2]:=5;
  bufS[3]:=5;
  bufS[4]:=0;
  bufS[5]:=0;
  bufS[6]:=0;
  bufS[7]:=0;
  bufS[8]:=0;
  bufS[9]:=0;
  bufS[10]:=0;
  bufS[11]:=0;
  bufS[12]:=0;
  bufS[13]:=0;
  bufS[14]:=0;
  output.Socket.SendBuf(BufS,14);
 
 
end;

Добавлено 19.04.13, 04:34
даже так будет правельнее

procedure TKpp.ding(Sender: TObject);
  var bufs:array[1..14] of byte;
    s:TSocket;
    SocketSet: TFDSet;
 // Òàéì-àóò äëÿ ôóíêöèè select
    Timeout: TTimeVal;
    Len,Val:integer;
begin
 
  //showmessage(inttostr(output.Socket.Handle));
 {
s:=output.Socket.Handle;
 FD_ZERO(SocketSet);
 FD_SET(s, SocketSet);
 Timeout.tv_sec := 0;
 Timeout.tv_usec := 50;
 Len := SizeOf(Integer);
 Val:=50;
 setsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
// getsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
 getsockopt(s, SOL_SOCKET, SO_RCVTIMEO, @Val, Len);
 getsockopt(s, SOL_SOCKET, SO_SNDTIMEO, @Val, Len);
 //showmessage(inttostr(val));
 
//if WSAAsyncSelect(S, form1.Handle, WM_USER+1, FD_READ or FD_WRITE)= SOCKET_ERROR then
 
  if select(0, @SocketSet, nil, nil, @Timeout)= SOCKET_ERROR then
    begin
      showmessage('îøèáêà ' +inttostr(WSAGetLastError));
 
    exit;
    end;
}
 
 
  bufS[1]:=30;
  bufS[2]:=5;
  bufS[3]:=5;
  bufS[4]:=0;
  bufS[5]:=0;
  bufS[6]:=0;
  bufS[7]:=0;
  bufS[8]:=0;
  bufS[9]:=0;
  bufS[10]:=0;
  bufS[11]:=0;
  bufS[12]:=0;
  bufS[13]:=0;
  bufS[14]:=0;
  output.Socket.SendBuf(BufS,14);
 
 
end;