FPC + Indy = Console Program

[eevee]

Здравствуйте!

Перерыл пол-интернета и так и не нашел полноценного примера IdTCPServer на Indy. Может кто нибудь помочь?

Код: Выделить всё

program test;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, IdTCPServer, IdContext
  { you can add units after this };

{$IFDEF WINDOWS}{$R test.rc}{$ENDIF}

var
  tcp: TIdTCPServer;

begin
  tcp := TIdTCPServer.Create(nil);
  tcp.ListenQueue:=1;
  tcp.MaxConnections:=1;
  tcp.DefaultPort:=9999;
  tcp.Active:=true;
end.                     

При выполнении ругается на необъявленную обязательную процедуру OnExecute, но вот как ее правильно объявить - уже всю голову сломал...

Код: Выделить всё

eevee@eevee_work ~/Projects/Lazarus/test $ ./test
An unhandled exception occurred at $0809E940 :
EIdTCPNoOnExecute : You must have an OnExecute event.
  $0809E940  EIDEXCEPTION__TOSS,  line 175 of IdException.pas
  $0809E871  EIDEXCEPTION__IFFALSE,  line 142 of IdException.pas
  $08079733  TIDTCPSERVER__CHECKOKTOBEACTIVE,  line 49 of IdTCPServer.pas
  $08094DB4  TIDCUSTOMTCPSERVER__SETACTIVE,  line 558 of IdCustomTCPServer.pas
  $08048336  main,  line 31 of test.lpr

[SergKam]

Обязательно indi? Он какойто монстроидальный глюк. Гораздо проще и понятней synapsehttp://www.synapse.ararat.cz/doku.php
Indy is a very large and complex set of complicated classes. In many cases you need simple things. Why use the very large Indy? Use the small Synapse! Synapse is very simple and maximally versatile.

[eevee]

Просто пробовал ихний synaser - обплевался, кучу ошибок выгребал из ихних исходников.

По теме - нашел решение, правда немного не так, как думал вначале, может кому надо:

Код: Выделить всё

program itcp_ip;

{$mode objfpc}{$H+}

uses
  cthreads, Classes, IdTCPClient, IdTCPServer, IdCustomTCPServer, IdContext, mysql50conn, sqldb, sysutils, baseunix

{$IFDEF WINDOWS}{$R itcp_ip.rc}{$ENDIF}

type
  TIdTCPServer = class(TIdCustomTCPServer)
    published
      function DoExecute(AContext: TIdContext):boolean;override;
  end;

var
  itcp_server: TIdTCPServer;

function TIdTCPServer.DoExecute(AContext: TIdContext):boolean;
begin
  // Пока соединение активно
  while AContext.Connection.Socket.Connected do
  begin
     // Выполняем то что надо
  end;
  // Вот тут мы уже потеряли соединение
end;

begin
  itcp_server := TIdTCPServer.Create(nil);
  with itcp_server do
  begin
    ListenQueue:=1;
    MaxConnections:=1;
    DefaultPort:=port;
    TerminateWaitTime:=5000;
  end;
  itcp_server.Active := true;
   // Тут ессно цикл на проверку чего либо для того, чтобы сервер не прекратил свою работу
  itcp_server.Active := false;
end.

Добавлено спустя 3 часа 59 минут 54 секунды:
Жесть... Самый простой способ - использовать TIdSimpleServer - для поддержания одного соединения, как раз то, что мне надо.
С TIdTCPServer так и не смог нормально открывать и закрывать сокеты, они вешаются со статусом TIME_WAIT в случайное время...

[Brainenjii]

Код: Выделить всё

...
Uses
...
 IdTCPServer, IdContext, IdGlobal, 
...
Type BServer = Class(TIdTCPServer)
  Private
...
    Procedure Execute(aThread: TIdContext);
...
  Public
...
   Constructor Build;
End;
...
Procedure BServer.Execute(aThread: TIdContext);
Var
  aString: String;
Begin
  aString := aThread.Connection.Socket.ReadLn;
  aString := 'All your "' + aString + '" are belong to us';
  aThread.Connection.Socket.WriteLn(aString);
End;
...
Constructor BServer.Build;
Begin
  Inherited Create(nil);
...
  OnExecute := @Execute;
  DefaultPort := 7667;
  Try
    Active := TRUE;
  Except On E: Exception Do
    Begin
      WriteLn(E.Message);
      Halt;
    End;
  End;
End;

Как-то так ^_^ Правда под win2003 не запустилось, но на lin вполне работало... В проекте я оставил просто

Код: Выделить всё

uses
  {$IFDEF UNIX}
    cthreads,
  {$ENDIF}

[eevee]

Спасибо большое! На будущее пригодится ^_^

[Linus]

Просьба к модератору удалить это сообщение.