Проверка существования подключения к 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 заранее благодарю и приношу извинения за то что отвлекаю Вас

Сбросил.

Цитата medved_68 @ 15.04.13, 12:11

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

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

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

Спасибо за то что показали правильно решение

medved_68 ознакомился с Вашим юнитом - осознал свою никчёмность ; Но когда я сегодня забрал дивайс под который я писал софтину осознание никчёмности усилилось. Этот сервер работает только с одним клиентом . А у меня в проге как раз один клиент из нитки проверял подключение, а другой ждет события в не блокируемом режиме. Да и реакция на отключение сервера секунд 30. Ваш код не проверял хочу спросить Вашего разрешения или если Вы считаете что результат будет тот же подскажите как еще можно проверить связь. Благодарю за то что дочитали этот текст до конца .

Цитата apprentice @ 16.04.13, 14:22

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

А вот отсюда по подробнее. Клиенты на разных портах сидят? Или на одном, сначала отработает один, закроет сокет, потом другой?

medved_68 Да нет они на одном порту висят но один в потоке, а второй просто висит. Тот что в потоке в синхронном и просто подключался отключался (тестил связь). Второй в асинхронном просто ждет события онРиад. Когда связь обрывалась и появлялась поток на это реагировал переподключая асинхронный сокет. Ну вощим пока я писал эту софтину и не было дивайса я сокет сервер держал на компе и все работало. И реагировало почти моментально, а сейчас увы.

Цитата apprentice @ 16.04.13, 16:00

Да нет они на одном порту висят но один в потоке, а второй просто висит.

Весьма занятно. Занятно то, что система не позволит корректно открыть второй сокет на занятом порту, вернув код либо 10048, либо 10056. Поэтому вариант может быть только один - ты не проверяешь результат выполнения функции.

Цитата apprentice @ 16.04.13, 16:00

Когда связь обрывалась и появлялась поток на это реагировал переподключая асинхронный сокет.

Зачем? Первая же операция запись/чтение в/из сокета при обрыве связи вернет ошибку. Необходимо ее корректно обработать и переподключиться. Или дождаться восстановления линка и переподключиться. Зачем ты так "завернул"?

Цитата medved_68 @ 16.04.13, 17:02

Зачем? Первая же операция запись/чтение в/из сокета при обрыве связи вернет ошибку. Необходимо ее корректно обработать и переподключиться. Или дождаться восстановления линка и переподключиться. Зачем ты так "завернул"?

сокет кдиент тока принимает

Цитата apprentice @ 16.04.13, 17:08

сокет кдиент тока принимает

Он и отправлять данные тоже может. А если он работает только на прием, то что мешает периодически (по таймеру) отправлять что то? И анализировать, сколько байт отправлено... Ведь если нет канала (ну обрыв, всяко бывает) - ошибка отправки гарантирована и можно принимать решение - как жить дальше.

Цитата medved_68 @ 16.04.13, 17:12

Цитата apprentice @ 16.04.13, 17:08

сокет кдиент тока принимает

Он и отправлять данные тоже может. А если он работает только на прием, то что мешает периодически (по таймеру) отправлять что то? И анализировать, сколько байт отправлено... Ведь если нет канала (ну обрыв, всяко бывает) - ошибка отправки гарантирована и можно принимать решение - как жить дальше.

Дык говорю же там дивайс. Не надо ему было сообщения слать. А я как то об этом не думал чтоб так тэстить или он включён. Попробую. Сработает не сработает не знаю но все равно Вам спасибо

Цитата apprentice @ 16.04.13, 17:19

Дык говорю же там дивайс. Не надо ему было сообщения слать.

Ты не ему сообщения шлешь. Стэк TCP/IP так устроен, что пришлет подтверждение ДОСТАВКИ пакета с флагом АСК. А твой девайс просто пакет проигнорирует и все. Но подтверждение получения пакета на той стороне ты получишь, а значит можно сделать вывод, что канал жив. Таким же образом работает и keep-alive пакеты. Таким же образом "проламывают" для ВХОДЯЩЕЙ связи NAT всякие Астериски и Скайпы...

Цитата medved_68 @ 16.04.13, 17:31

Цитата apprentice @ 16.04.13, 17:19

Дык говорю же там дивайс. Не надо ему было сообщения слать.

Ты не ему сообщения шлешь. Стэк TCP/IP так устроен, что пришлет подтверждение ДОСТАВКИ пакета с флагом АСК. А твой девайс просто пакет проигнорирует и все. Но подтверждение получения пакета на той стороне ты получишь, а значит можно сделать вывод, что канал жив. Таким же образом работает и keep-alive пакеты. Таким же образом "проламывают" для ВХОДЯЩЕЙ связи NAT всякие Астериски и Скайпы...

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

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,14)
 
end;

событие онИррор возникло спустя 20 сек
код события онИррор. Можно ли как то ускорить проверку?
Скажу честно раньше делал пингом. Было чуть быстрее но пинг со времинем при длительном отключении залипал и переставал реагировать да и там был только один дивайс а тут в теории их может быть до 15

Цитата medved_68 @ 16.04.13, 17:02

Занятно то, что система не позволит корректно открыть второй сокет на занятом порту, вернув код либо 10048, либо 10056.

C чего бы это? Он же про удаленный порт (входящий на девайсе) говорит, а не локальный (исходящий на компе)

Добавлено 17.04.13, 06:01

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

событие онИррор возникло спустя 20 сек

Это когда по таймауту отвалилось, видимо. А еще можно проверять результат Send, либо при отправке взводить флаг и ожидать события OnWrite (не помню точно, как в этом классе сокета зовется событие отправки данных). В таймере проверять, если события отправки не происходит некоторое время - связь оборвана.

Цитата Fr0sT @ 17.04.13, 05:56

Добавлено 17.04.13, 06:01

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

событие онИррор возникло спустя 20 сек

Это когда по таймауту отвалилось, видимо. А еще можно проверять результат Send, либо при отправке взводить флаг и ожидать события OnWrite (не помню точно, как в этом классе сокета зовется событие отправки данных). В таймере проверять, если события отправки не происходит некоторое время - связь оборвана.

Сейчас попробую порыть

Цитата Fr0sT @ 17.04.13, 05:56

А еще можно проверять результат Send,

Именно это я предлагаю делать:

Цитата medved_68 @ 16.04.13, 17:12

то что мешает периодически (по таймеру) отправлять что то? И анализировать, сколько байт отправлено...

Но, видимо, как то не так предлагаю... А 20 сек. для сети - это ерунда, можно смело забить. Весь вопрос в том, предусмотрена ли буферизация отправляемых пакетов пользовательским протоколом, чтобы можно было повторить отправку при восстановлении канала и без потерь данных.

Добавлено 17.04.13, 10:07

Цитата Fr0sT @ 17.04.13, 05:56

Он же про удаленный порт (входящий на девайсе) говорит, а не локальный (исходящий на компе)

Неужели?

Цитата apprentice @ 16.04.13, 16:00

Да нет они на одном порту висят но один в потоке, а второй просто висит.

Весьма трудно ClientSocket представить на удаленном девайсе в контексте процитированного.

Цитата medved_68 @ 17.04.13, 10:04

Неужели?

Ну, я понял эту фразу как "Они к одному порту присоединены", поскольку локальный порт в контексте задачи тут вообще не пришей кобыле хвост.

Добавлено 17.04.13, 10:44

Цитата medved_68 @ 17.04.13, 10:04

20 сек. для сети - это ерунда, можно смело забить

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

Цитата 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;

Цитата apprentice @ 19.04.13, 04:29

output.Socket.SendBuf(BufS,14);

Мдя....Ну и где ты проверяешь результат вызова этой функции? Сколько байт у тебя реально отправилось в канал?

Решил проблему следующим образом. Знаю что не элегантно. Знаю Вы решили бы красивее но так работает и ответ о отключении приходит с приличной скоростью.

unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 winsock, StdCtrls, IdIcmpClient;
 
type
  PingTread = class(TThread)
  ind: TIdIcmpClient;
  public
    tex:string;
  private
 
    { Private declarations }
  protected
 
    procedure Execute; override;
    procedure scan();
    procedure FormUpd;
  public
    constructor create_tr(ips: string; port:integer);
  end;
implementation
  uses unit2, unit1;
 
 
constructor PingTread.create_tr(ips: string; port:integer);
begin
  inherited Create(true);
  ind:=TIdIcmpClient.Create(nil);
  ind.Port:=port;
  ind.Host:=ips;
 
  FreeOnTerminate:=true;
  Priority:=tpLower;
  Resume;
 
end;
 
procedure PingTread.Execute;
begin
  while true do
  begin
    scan();
    Synchronize(FormUpd);
    sleep(4000);
  end;
end;
 
procedure PingTread.FormUpd;
begin
  form1.Label3.Caption:=tex;
  if tex='connect' then form1.flagOut:=true
  else form1.flagOut:=false
end;
 
procedure PingTread.scan();
begin
  ind.Ping;
  if ind.ReplyStatus.TimeToLive=100 then tex:='connect'
  else tex:='disconnect'
end;
 
 
end.

Добавлено 24.04.13, 05:49

Цитата medved_68 @ 19.04.13, 12:53

Цитата apprentice @ 19.04.13, 04:29

output.Socket.SendBuf(BufS,14);

Мдя....Ну и где ты проверяешь результат вызова этой функции? Сколько байт у тебя реально отправилось в канал?

вот чисто для себя все таки хочу разобраться. Как это проверить?

Цитата apprentice @ 24.04.13, 05:43

while true do

А поток, стало быть, ты разрушаешь извне? Или "утечка памяти" на неразрушенный объект?

Цитата apprentice @ 24.04.13, 05:43

вот чисто для себя все таки хочу разобраться. Как это проверить?

Ну так почитай справку, что ли, по функции SendBuf. ЧТО ОНА ВОЗВРАЩАЕТ в качестве РЕЗУЛЬТАТА своего ВЫПОЛНЕНИЯ...И сразу станет ясно, как это делается.

Сообщение отредактировано: medved_68 - 24.04.13, 06:50

Цитата medved_68 @ 24.04.13, 06:49

Цитата apprentice @ 24.04.13, 05:43

while true do

А поток, стало быть, ты разрушаешь извне? Или "утечка памяти" на неразрушенный объект?

Цитата apprentice @ 24.04.13, 05:43

вот чисто для себя все таки хочу разобраться. Как это проверить?

Ну так почитай справку, что ли, по функции SendBuf. ЧТО ОНА ВОЗВРАЩАЕТ в качестве РЕЗУЛЬТАТА своего ВЫПОЛНЕНИЯ...И сразу станет ясно, как это делается.

он разрушается при закрытии приложения. Он же должен висеть в памяти пока оно запущено конечно можно сделать и по таймеру. Как Вы считаете лучше?

Цитата apprentice @ 24.04.13, 07:05

он разрушается при закрытии приложения.

Я понимаю. Но сомнения. Не вяжется вот это:

Цитата apprentice @ 24.04.13, 05:43

FreeOnTerminate:=true;

с вот этим:

Цитата apprentice @ 24.04.13, 05:43

while true do

Цитата apprentice @ 24.04.13, 07:05

Как Вы считаете лучше?

Неверно. Считать должен ты. Я же не знаю полного расклада. Так что.....Может у тебя там вообще комп выключается с прекращением работы приложения и такой подход вполне оправдан.

попробовал сделать так

  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;
  i:=output.Socket.SendBuf(BufS,14);
  form1.Label3.Caption:=inttostr(i);

если я правильно Вас понял то при отключении число должно стать = 0 это происходит через 40 сек после отключения. Это очень долго.

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

если я правильно Вас понял то при отключении число должно стать = 0

Да.

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

Это очень долго.

Почему?

Цитата medved_68 @ 24.04.13, 07:09

Неверно. Считать должен ты. Я же не знаю полного расклада. Так что.....Может у тебя там вообще комп выключается с прекращением работы приложения и такой подход вполне оправдан.

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

Цитата apprentice @ 24.04.13, 07:24

Ну в принципе да если стопорнуть это приложение никто никуда не выйдет и не задет на предприятии.

СКУД?

Цитата medved_68 @ 24.04.13, 07:28

Цитата apprentice @ 24.04.13, 07:24

Ну в принципе да если стопорнуть это приложение никто никуда не выйдет и не задет на предприятии.

СКУД?

Вы шпионите за мной Да он самый

Добавлено 24.04.13, 07:37

Цитата apprentice @ 24.04.13, 07:24

Цитата medved_68 @ 24.04.13, 07:09

Неверно. Считать должен ты. Я же не знаю полного расклада. Так что.....Может у тебя там вообще комп выключается с прекращением работы приложения и такой подход вполне оправдан.

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

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

Добавлено 24.04.13, 07:38

Цитата medved_68 @ 24.04.13, 07:23

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

если я правильно Вас понял то при отключении число должно стать = 0

Да.

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

Это очень долго.

Почему?

ой чутка не то процитировал

Цитата apprentice @ 24.04.13, 07:32

Да он самый

Тогда у тебя неправильная топология. Ридер должен на борту иметь UNIQUE-коды карт. У меня каждый ридер оснащен восемью микросхемами 24С256 (для этой серии это максимальный пул адресации), что мне дает возможность без ОБРАЩЕНИЯ К ЦЕНТРАЛЬНОМУ серверу спокойно пропускать 2000 UNIQUE-кодов формата E-marine. Разумеется, они меняются каждый день в 00.00 в соответствии с поданными заявками мастеров на следующий день (подушевой список смен). Обычно в смене не более 125-200 человек, так что запас для ридеров весьма велик. Сам ридер фиксирует до 10 записей прохода и отправляет их на сервер, который на основе данных формирует документ посещения. Этим у меня занимается 1С (ну проще оказалось найти тело, понимающее в 1С, чем в тех же системах доступа, которые бесплатно предлагают все, кому не лень). Разумеется, если сервер почему то недоступен, то вся эта байда начинает сохранятся на mикроSD. Поэтому мой тебе совет - перекраивай топологию, пока не увяз по уши. Сеть не должна стать причиной сбоев СКУД. Иначе тебя могут серьезно и на нехилые бабки прижать те же пожарные, к примеру....

Цитата medved_68 @ 24.04.13, 07:52

Цитата apprentice @ 24.04.13, 07:32

Да он самый

Тогда у тебя неправильная топология. Ридер должен на борту иметь UNIQUE-коды карт. У меня каждый ридер оснащен восемью микросхемами 24С256 (для этой серии это максимальный пул адресации), что мне дает возможность без ОБРАЩЕНИЯ К ЦЕНТРАЛЬНОМУ серверу спокойно пропускать 2000 UNIQUE-кодов формата E-marine. Разумеется, они меняются каждый день в 00.00 в соответствии с поданными заявками мастеров на следующий день (подушевой список смен). Обычно в смене не более 125-200 человек, так что запас для ридеров весьма велик. Сам ридер фиксирует до 10 записей прохода и отправляет их на сервер, который на основе данных формирует документ посещения. Этим у меня занимается 1С (ну проще оказалось найти тело, понимающее в 1С, чем в тех же системах доступа, которые бесплатно предлагают все, кому не лень). Разумеется, если сервер почему то недоступен, то вся эта байда начинает сохранятся на mикроSD. Поэтому мой тебе совет - перекраивай топологию, пока не увяз по уши. Сеть не должна стать причиной сбоев СКУД. Иначе тебя могут серьезно и на нехилые бабки прижать те же пожарные, к примеру....

проблема в том что ридер чисто сетевой и контроллер тоже(Данные хранить не умею памяти нет). Замки правда все электромагнитные то есть при отключении света все откроется. Да и на предприятии для которого я пишу эту гадость сейчас стоит обычный домофон еще та система сами понимаете если кто-то теряет карту чтобы её удалить надо все карты перебивать. А Вы насколько я понял используете контроллер с памятью и переходником на Ethernet. Если Вас не затруднит напишите модели оборудования я гляну что оно из себя представляет.

Добавлено 24.04.13, 09:12
Хотя судя по всему у вас ети два устройства совмещены в одном блоке и не удивлюсь если там еще есть какая то линуксоидная операционочка которая управляет этим аццким дивайсом

Цитата apprentice @ 24.04.13, 09:01

А Вы насколько я понял используете контроллер с памятью и переходником на Ethernet. Если Вас не затруднит напишите модели оборудования я гляну что оно из себя представляет.

Нет. Я использую блочную структуру:
1. Считыватель -
2. Цп на микроконтроллере.
3. Канал связи либо на Wiznet -
либо Olimex -
либо Wi-Fi или BlueTooth - . Так проще, ибо то, что подходит мне лично и тем, кто с меня чего то просит, стоит как небольшой ледокол. В готовом виде, разумеется.

Добавлено 24.04.13, 10:39

Цитата apprentice @ 24.04.13, 09:01

и не удивлюсь если там еще есть какая то линуксоидная операционочка

Нет. Обычный асм модуль на 2072 байта.

Добавлено 24.04.13, 10:41

Цитата apprentice @ 24.04.13, 09:01

Замки правда все электромагнитные то есть при отключении света все откроется.

Для того, что бы открылось - сначала необходимо обесточить. Это если в случае ЧП...

А где само устройство хранящее данные карт? просто в спецификации ридера я не вижу никаких упоминаний про хранение там написано только "Данные обрабатываются и соответствующим рядом передается в последовательной форме
в ведущий блок.". в принципе у меня схожий девайс только сразу на интерфейсе Ethernet http://vkmodule.com.ua/Ethernet/Ethernet5.html правда там есть и на RS-232 но под него нужно отдельную сеть тянуть и опять таки никаких гарантий на то что не произойдет обрыв. Ну а вот по поводу ВайФай преобразователей это вы меня порадовали. Приятное известие. Уточните пожалуйста сколько стоит один ВайФай преобразователь.

Добавлено 24.04.13, 11:45

Цитата medved_68 @ 24.04.13, 10:38

Для того, что бы открылось - сначала необходимо обесточить. Это если в случае ЧП...

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