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

Существует устройство которое выступает Socket Server. Сервер судя по его поведению работает в режиме stThreadBlocking и скидывает пакеты данных размером в 1 кб. есть код

unit Unit2;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, WinSock;
 
Type
  TKpp=class
  private
    input: TClientSocket;
    output: TClientSocket;
    controller: TClientSocket;
 
   // procedure outputRead(Sender: TObject; Socket: TCustomWinSocket);
   // procedure controllerRead(Sender: TObject; Socket: TCustomWinSocket);
 
  public
    name,sin,s1in:string;
    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);
    constructor create;
    destructor destroy;
 
end;
implementation
  uses unit1;
{ TKpp }
 
***
 
constructor TKpp.create;
begin
  input:=TClientSocket.Create(nil);
  input.OnRead:=Read;
  output:=TClientSocket.Create(nil);
  output.OnRead:=Read;
  controller:=TClientSocket.Create(nil);
  controller.OnRead:=Read;
end;
 
procedure TKpp.Read(Sender: TObject; Socket: TCustomWinSocket);
var buf:byte;
begin
  if Socket.ReceiveLength<6 then
  begin
    input.ClientType:=ctBlocking;
    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);
        end;
      if sender=controller then
        Begin
          showmessage('Êîíòðîëëåð');
        end;
    end;
 
end;
 
***
end;

как сделать так что бы каждый сокет клиент проверял существование своего сокет сервера. Сокет клиенты в не блокируемом режиме. Очень жду предложений. Предложения со Stream-ом желательно с примерами так как со Stream-ом не работал.

Цитата apprentice @ 10.04.13, 08:45

как сделать так что бы каждый сокет клиент проверял существование своего сокет сервера.

Если при установке соединения серверный хост будет недоступен, то по таймауту вывалится событие ошибки OnError с кодом 10065 (по памяти). Вот это событие и необходимо обработать.

Цитата medved_68 @ 11.04.13, 10:33

Если при установке соединения серверный хост будет недоступен, то по таймауту вывалится событие ошибки OnError с кодом 10065 (по памяти). Вот это событие и необходимо обработать.

Согласен. То есть Вы предлагаете создать что-то вроде

while true do
Begin
  Try
    output.Open;
    form1.Label1.Caption:='Все норм'
  Except
    form1.Label1.Caption:='Не все норм'
  End;
  sleep(5000);
end;
end;

сразу скажу что не работает.

Цитата apprentice @ 11.04.13, 12:10

То есть Вы предлагаете создать что-то вроде

Нет. Это бы сработало в случае блокирующего режима.

Цитата apprentice @ 11.04.13, 12:10

сразу скажу что не работает.

И не будет работать. Поясню. Твой код выполниться и НИКАКОГО исключения, которое ты пытаешься поймать except в тот момент не поднимется (сокеты ведь в неблокируемом режиме). Просто через определенный таймаут процедура открытия сокета вернет код завершения 10065 (нет такого хоста). И поднимется событие сокета OnError, в которое будет передан этот код в виде DWORD'a, про которое я тебе и говорил. Обработав это событие, т.е. проанализировав код ошибки, ты точно будешь знать, что произошло при попытке открытия сокета.

Добавлено 12.04.13, 05:36
Вот такое событие будет сгенерировано при возврате сокетом ошибки:

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 
end;

Цитата medved_68 @ 12.04.13, 05:32

И не будет работать. Поясню. Твой код выполниться и НИКАКОГО исключения, которое ты пытаешься поймать except в тот момент не поднимется (сокеты ведь в неблокируемом режиме). Просто через определенный таймаут процедура открытия сокета вернет код завершения 10065 (нет такого хоста). И поднимется событие сокета OnError, в которое будет передан этот код в виде DWORD'a, про которое я тебе и говорил. Обработав это событие, т.е. проанализировав код ошибки, ты точно будешь знать, что произошло при попытке открытия сокета.

Добавлено 12.04.13, 05:36
Вот такое событие будет сгенерировано при возврате сокетом ошибки:

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 
end;

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

unit Unit2;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, WinSock, Sockets;
 
Type
  TKpp=class
  private
    TcpClient1: TTcpClient;
    input: TClientSocket;
    output: TClientSocket;
    controller: TClientSocket;
 
 
   // 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;
    constructor create;
    destructor destroy;
 
end;
implementation
  uses unit1, Thread;
{ TKpp }
 
***
 
constructor TKpp.create;
begin
 
  TcpClient1:=TTcpClient.create(nil);
  input:=TClientSocket.Create(nil);
  input.ClientType:=ctBlocking;
  input.OnConnect:=inputcon;
  input.OnError:=Err;
  //input.OnRead:=Read;
  output:=TClientSocket.Create(nil);
  output.OnRead:=Read;
  output.OnError:=Err;
  //output.OnConnecting:=tesConn;
 
 
  controller:=TClientSocket.Create(nil);
  controller.OnRead:=Read;
end;
 
***
procedure Tkpp.Err(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 
  ErrorCode:=0;
  Erro:='Òóò ÷òîòî íå òàê';
 
 
end;
 
а тут поток

unit thread;
 
interface
 
uses
  Classes, SysUtils, Dialogs;
 
type
  TNt = class(TThread)
  private
    { Private declarations }
  protected
    er:string;
    procedure Execute; override;
    procedure UpdateForm;
  end;
 
implementation
uses unit1,unit2;
 
{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,
 
      Synchronize(UpdateCaption);
 
  and UpdateCaption could look like,
 
    procedure Nt.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
 
{ Nt }
 
procedure TNt.Execute;
  var kpp:Tkpp;
      i:integer;
begin
i:=0;
  kpp:=TKpp.Create;
  kpp.setIPout(form1.edit4.Text);
  kpp.setPortout(form1.edit2.Text);
  while i<2000000 do
    begin
 
 
      kpp.outActivate(true);
      sleep(5000);
      er:=kpp.Erro;//kpp.Erro;
      kpp.outActivate(False);
 
      Synchronize(UpdateForm);
 
      inc(i);
    end;
end;
 
 
procedure TNt.UpdateForm;
begin
 
 form1.Label1.Caption:=er;
 form1.Label1.Refresh;
 
end;
 
end.

Подскажите почему ошибка в потоке не возникает?

Решил проблему следующим способом
код потока

unit thread;
 
interface
 
uses
  Classes, SysUtils, Dialogs;
 
type
  TNt = class(TThread)
  private
    { Private declarations }
  protected
    er:string;
    procedure Execute; override;
    procedure UpdateForm;
  end;
 
implementation
uses unit1,unit2;
 
{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,
 
      Synchronize(UpdateCaption);
 
  and UpdateCaption could look like,
 
    procedure Nt.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
 
{ Nt }
 
procedure TNt.Execute;
  var kpp1:Tkpp;
      i:integer;
begin
i:=0;
 
      kpp1:=TKpp.Create;
      kpp1.setIPout(form1.edit4.Text);
      kpp1.setPortout(form1.edit2.Text);
      kpp1.clienttype('output',1);
  while true do
    begin
      try
      kpp1.outActivate(true);
      sleep(1000);
      er:='Подключено'
      except
      er:='не получилось';
      end;
      kpp1.outActivate(False);
 
      Synchronize(UpdateForm);
 
      inc(i);
    end;
end;
 
 
procedure TNt.UpdateForm;
begin
 
 form1.Label1.Caption:=er;
 form1.Label1.Refresh;
 
end;
 
end.

Код класса ТКрр

unit Unit2;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, WinSock, Sockets;
 
Type
  TKpp=class
  private
    TcpClient1: TTcpClient;
    input: TClientSocket;
    output: TClientSocket;
    controller: TClientSocket;
 
 
   // 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);
 
 
    constructor create;
    destructor destroy;
 
end;
implementation
  uses unit1, Thread;
{ TKpp }
 
***
 
constructor TKpp.create;
begin
 
  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;
 
***
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;

Цитата apprentice @ 12.04.13, 07:17

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

Ну хотя бы потому, что ты не привел код выборки сообщений Винды из потока по типу:

 while (not Terminated) and (GetMessage(M,0,0,0)) do
  begin
    TranslateMessage(M);
    DispatchMessage(M);
  end;
end;

Поэтому...о чем размышлять, то?

Цитата apprentice @ 12.04.13, 12:49

input.ClientType:=ctBlocking;

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

Цитата medved_68 @ 12.04.13, 16:18

Цитата apprentice @ 12.04.13, 07:17

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

Ну хотя бы потому, что ты не привел код выборки сообщений Винды из потока по типу:

 while (not Terminated) and (GetMessage(M,0,0,0)) do
  begin
    TranslateMessage(M);
    DispatchMessage(M);
  end;
end;

Поэтому...о чем размышлять, то?

Цитата apprentice @ 12.04.13, 12:49

input.ClientType:=ctBlocking;

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

Спасибо за подсказку. Дело в том что я только начал разбираться с сетями и потоками по этому некоторые моменты не до конца понимаю. Отсюда и столько вопросов и ошибок.

Цитата apprentice @ 15.04.13, 04:53

Спасибо за подсказку. Дело в том что я только начал разбираться с сетями и потоками по этому некоторые моменты не до конца понимаю.

Хм...не понимать как устроено VCL....Это сильно. Видишь ли, судя по коду, ты пытаешься засунуть КОМПОНЕНТ клиентского сокета в поток (там его создаешь в рантайме). Я не знаю, обрезанный ли у тебя код или ты его привел полностью, но ты спрашиваешь о таких вещах, которые приведенный тобою код не отражает. Вообще. Что бы КОМПОНЕНТ VCL работал в потоке тебе необходимо, как минимум сделать такое:

procedure TThrSockClient.Execute;
var
  M: TMsg;
begin
  FOneRes:=False;
 
  PeekMessage(M,0,0,0,PM_NoRemove);
  FSock := TClientSocket.Create(nil);
  FSock.OnConnecting := FSockConnecting;
  FSock.OnConnect := FSockConnect;
  FSock.OnDisconnect := FSockDisconnect;
  FSock.OnRead := FSockRead;
  FSock.OnWrite := FSockWrite;
  FSock.OnError := FSockError;
  FSock.Address := FAddr;
  FSock.Port := FPort;
  SetEvent(FTag);
  while (not Terminated) and (GetMessage(M,0,0,0)) do
  begin
    TranslateMessage(M);
    DispatchMessage(M);
  end;
end;

Тогда у тебя начнется цикл выборки сообщений системы в данном потоке и, соответственно, начнут работать эвенты событий, перенаправляя выбранные из очереди сообщения в нужные процедуры обработки по типу:

procedure TThrSockClient.FSockRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i:Integer;ax:string;
begin
  FOnEvent(Self,FSock.Socket,saRead);
  FOnProcEvent(Self,FSock.Socket,saRead);
  i:=ReceiveLength;
  SetLength(mass,i);
  if not FOneRes then
    begin
      ReceiveBuf(mass[0],i);
      SetLength(ax,6);
      move(mass[0],ax[1],6);
      if ax = 'stroka' then
        begin
          if i>6 then
            begin
              SetLength(Stroka,i-6);
              move(mass[6],Stroka[1],i-6);
              PostMessage(FPadre,SOCKET_STROKA,Integer(ax),6);
            end
              else FOneRes:=True;
        end;
    end
      else
    begin
      ReceiveBuf(mass[0],i);
      SetLength(ax,i);
      move(mass[0],ax[1],i);
      PostMessage(FPadre,SOCKET_STROKA,Integer(ax),0);
      FOneRes:=False;
    end;
end;

Как то так....

Цитата medved_68 @ 15.04.13, 05:59

Цитата apprentice @ 15.04.13, 04:53

Спасибо за подсказку. Дело в том что я только начал разбираться с сетями и потоками по этому некоторые моменты не до конца понимаю.

Хм...не понимать как устроено VCL....Это сильно. Видишь ли, судя по коду, ты пытаешься засунуть КОМПОНЕНТ клиентского сокета в поток (там его создаешь в рантайме). Я не знаю, обрезанный ли у тебя код или ты его привел полностью, но ты спрашиваешь о таких вещах, которые приведенный тобою код не отражает. Вообще. Что бы КОМПОНЕНТ VCL работал в потоке тебе необходимо, как минимум сделать такое:

procedure TThrSockClient.Execute;
var
  M: TMsg;
begin
  FOneRes:=False;
 
  PeekMessage(M,0,0,0,PM_NoRemove);
  FSock := TClientSocket.Create(nil);
  FSock.OnConnecting := FSockConnecting;
  FSock.OnConnect := FSockConnect;
  FSock.OnDisconnect := FSockDisconnect;
  FSock.OnRead := FSockRead;
  FSock.OnWrite := FSockWrite;
  FSock.OnError := FSockError;
  FSock.Address := FAddr;
  FSock.Port := FPort;
  SetEvent(FTag);
  while (not Terminated) and (GetMessage(M,0,0,0)) do
  begin
    TranslateMessage(M);
    DispatchMessage(M);
  end;
end;

Тогда у тебя начнется цикл выборки сообщений системы в данном потоке и, соответственно, начнут работать эвенты событий, перенаправляя выбранные из очереди сообщения в нужные процедуры обработки по типу:

procedure TThrSockClient.FSockRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i:Integer;ax:string;
begin
  FOnEvent(Self,FSock.Socket,saRead);
  FOnProcEvent(Self,FSock.Socket,saRead);
  i:=ReceiveLength;
  SetLength(mass,i);
  if not FOneRes then
    begin
      ReceiveBuf(mass[0],i);
      SetLength(ax,6);
      move(mass[0],ax[1],6);
      if ax = 'stroka' then
        begin
          if i>6 then
            begin
              SetLength(Stroka,i-6);
              move(mass[6],Stroka[1],i-6);
              PostMessage(FPadre,SOCKET_STROKA,Integer(ax),6);
            end
              else FOneRes:=True;
        end;
    end
      else
    begin
      ReceiveBuf(mass[0],i);
      SetLength(ax,i);
      move(mass[0],ax[1],i);
      PostMessage(FPadre,SOCKET_STROKA,Integer(ax),0);
      FOneRes:=False;
    end;
end;

Как то так....

Вот это исчерпывающий ответ. Огромное спасибо. Да действительно код приведен не полностью так как его там многовато.

Единственное что хотелось бы уточнить из вашего кода если это конечно же Вас не затруднит 2 момента
что находится в FOneRes и Ftag. Почитав описание SetEvent.

procedure SetEvent(ComponentWithEvent: TComponent;
const Event: string;
ComponentWithHandler: TComponent;
const Handler: string);

стало интересно как реализован Ftag.

Цитата apprentice @ 15.04.13, 08:36

Единственное что хотелось бы уточнить из вашего кода если это конечно же Вас не затруднит 2 момента
что находится в FOneRes и Ftag.

FOneRes это флаг приема. При первом проходе он False, что означает, что прилетела какая то команда пользовательского протокола. Вот ее и начинаем разбирать, что бы выяснить, а что делать далее. Узнав, что это "stroka", устанавливаем флаг, так как последующие пакеты будут данными, которые сливаем в массив до тех пор, пока размер, переданный в команде "stroka" не совпадет с количеством принятых байт. Далее сбрасываем флаг и снова ожидание команды....Как то так (по памяти)...
Ну а Ftag - типичный эвент:

FTag := CreateEvent(nil,True,False,nil);

который необходим для ожидания нормального старта потока и используется вот так:

procedure TThrSockClient.WaitStart;
begin
  try
    if WaitForSingleObject(FTag,100)<>WAIT_OBJECT_0 then raise Exception.Create('Error create object');
  finally
    CloseHandle(FTag);
    FTag := 0;
  end;
end;

Цитата medved_68 @ 15.04.13, 09:19

Цитата apprentice @ 15.04.13, 08:36

Единственное что хотелось бы уточнить из вашего кода если это конечно же Вас не затруднит 2 момента
что находится в FOneRes и Ftag.

FOneRes это флаг приема. При первом проходе он False, что означает, что прилетела какая то команда пользовательского протокола. Вот ее и начинаем разбирать, что бы выяснить, а что делать далее. Узнав, что это "stroka", устанавливаем флаг, так как последующие пакеты будут данными, которые сливаем в массив до тех пор, пока размер, переданный в команде "stroka" не совпадет с количеством принятых байт. Далее сбрасываем флаг и снова ожидание команды....Как то так (по памяти)...
Ну а Ftag - типичный эвент:

FTag := CreateEvent(nil,True,False,nil);

который необходим для ожидания нормального старта потока и используется вот так:

procedure TThrSockClient.WaitStart;
begin
  try
    if WaitForSingleObject(FTag,100)<>WAIT_OBJECT_0 then raise Exception.Create('Error create object');
  finally
    CloseHandle(FTag);
    FTag := 0;
  end;
end;

Только не сочтите за наглость но не могли бы Вы выложить текст данного юнита целиком.

Цитата apprentice @ 15.04.13, 11:36

Только не сочтите за наглость но не могли бы Вы выложить текст данного юнита целиком.

Мыло в приват - сброшу.

medved_68 vitaliy_kov@mail.ru заранее благодарю и приношу извинения за то что отвлекаю Вас