IdTCPServer sans Form visible

Version imprimable

23/02/2016, 10h15
larchitecte

IdTCPServer sans Form visible

Bonjour à tous,

J'ai créé une application serveur, en utilisant le composant IdTCPServer sans Form visible qui reste active grâce à une boucle infinie.
Ma question est donc la suivante : existe t-il un moyen de faire tourner un serveur de type IdTCPServer sans Form visible et sans boucle infinie ?
Si oui, avez-vous un exemple ?

Merci de vos réponses.
23/02/2016, 12h46
Lung

Un service ?

Sur un executable normale, impossible de se passer de la boucle infinie (comme celle du Application.Run )
Le Service comme le suggère Lung est tout à fait pertinent,
un peu plus chiant à débugguer mais tout à fait fonctionnel,
Si tu te débrouilles bien, tu peux faire un EXE normal pour le débogage, un autre EXE Service pour la PROD
A part, l'utilisation du Journal via TService.LogMessage que l'on ne peut pas utiliser en EXE normal, il y a pas de grande différence en terme de code
Juste ne jamais utilisé de TForm, ni de Dialogs !

personnellement, je l'utilise mais pour TServerSocket en mode full thread :

un thread pour le listen
un thread par client connecté, au plus 20
un thread de file d'attente des messages (reçus par les TWinSocketStream) traités en FIFO
un thread de traitements des message et des opérations sur le Base de Données
un thread pour le TIdFTPServer intégré
un thread de notification inter-process (envoie vers les modules connectés via un TClientSocket)
un thread de notification par mail (monitoring)
un thread de surveillance de dossier et récupération de fichier
un thread d'envoi de fichier

Sinon, la boucle infinie n'a rien de grave si elle codée via l'attente de message, cela coute 0% CPU d'attendre les messages,
voici une variante pour le TServerSocket

Code:

1
2
3
4
5
6
7
8
9
10
program Server;
 
uses
  ServerApplicationClasses in 'ServerApplicationClasses.pas';
 
{$R *.res}
 
begin
  RunServer();
end.

Le TServerSocket est en mode stNonBlocking dans cet exemple
Donc au lieu d'utiliser des Threads et des TWinSocketStream, cela utilise le message Windows pour déclencher les Events !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
 
unit ServerApplicationClasses;
 
interface
 
uses
  Windows, SysUtils, Messages, StrUtils, ScktComp;
 
type
  TServerApplication = class(TObject)
  private
    FServerSocket: TServerSocket;
    FServerTerminated: Boolean;
    FConnectCount: Integer;
    FReadCount: Integer;
    FReadCharCount: Integer;
 
    procedure ClientConnectEventHandler(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientReadEventHandler(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientDisconnectEventHandler(Sender: TObject; Socket: TCustomWinSocket);
 
  public
    constructor Create();
    destructor Destroy; override;
 
    procedure Run();
  end;
 
procedure RunServer();
 
implementation
 
//---------------------------------------------------------------------------
procedure RunServer();
begin
  with TServerApplication.Create() do
  try
    Run();
  finally
    Free();
  end
end;
 
//---------------------------------------------------------------------------
constructor TServerApplication.Create();
begin
  inherited Create();
 
  FServerSocket := TServerSocket.Create(nil);
  FServerSocket.Port := 12345;
  FServerSocket.ServerType := stNonBlocking; // C'est le plus simple à gérer !
  FServerSocket.OnClientConnect := ClientConnectEventHandler;
  FServerSocket.OnClientRead := ClientReadEventHandler;
  FServerSocket.OnClientDisconnect := ClientDisconnectEventHandler;
end;
 
//---------------------------------------------------------------------------
destructor TServerApplication.Destroy();
begin
  FreeAndNil(FServerSocket);
 
  inherited Destroy();
end;
 
//---------------------------------------------------------------------------
procedure TServerApplication.Run();
var
  Msg: TMsg;
begin
  FServerSocket.Open();
 
  while not FServerTerminated do
  begin
    if WaitMessage() then
    begin
      if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
      begin
        case Msg.message of
          WM_QUIT :
            FServerTerminated := True;
 
          CM_SOCKETMESSAGE,
          CM_DEFERFREE,
          CM_LOOKUPCOMPLETE :
            DispatchMessage(Msg);
        end;
 
        if (FConnectCount > 0) and (FServerSocket.Socket.ActiveConnections = 0) then
          FServerTerminated := True;
      end
    end
    else
      FServerTerminated := True;
  end
end;
 
//---------------------------------------------------------------------------
procedure TServerApplication.ClientConnectEventHandler(Sender: TObject; Socket: TCustomWinSocket);
begin
  OutputDebugString(PChar('Connect : ' + Socket.RemoteAddress));
  Inc(FConnectCount);
  Socket.SendText(Socket.RemoteAddress + ' : your are connection N°' + IntToStr(FConnectCount) + sLineBreak);
end;
 
//---------------------------------------------------------------------------
procedure TServerApplication.ClientReadEventHandler(Sender: TObject; Socket: TCustomWinSocket);
var
 Buf: String;
 CharCount: Integer;
begin
  Buf := Socket.ReceiveText();
  CharCount := Length(Buf);
  Inc(FReadCharCount, CharCount);
  Inc(FReadCount);
  Socket.SendText(Socket.RemoteAddress + ' : server have receive ' + IntToStr(CharCount) + ' chars [total : ' + IntToStr(FReadCharCount) + ' chars, ' + IntToStr(FReadCount) + ' packets]' + sLineBreak);
 
  if (CharCount = 1) then
  begin
    if Ord(Buf[1]) = VK_ESCAPE then
      Socket.Close();
  end
  else
    if AnsiContainsText(Buf, 'STOP') then
      FServerTerminated := True;
end;
 
//---------------------------------------------------------------------------
procedure TServerApplication.ClientDisconnectEventHandler(Sender: TObject; Socket: TCustomWinSocket);
begin
  OutputDebugString(PChar('Disconnect : ' + Socket.RemoteAddress));
end;
 
end.

23/02/2016, 15h28
larchitecte

Merci à vous deux de vos réponses. Je vais me pencher sur les services et je vous tiendrai au courant.
02/03/2016, 18h02
LadyWasky

Un IdTCPServer maintenu actif, ok , pas de soucis, on ouvre la connexion (Open), mais grâce à une boucle infinie ??? Nan, jamais vu, il y a un truc qui cloche dans le "design" de votre appli.

Le déclenchement des actions se fait par un évènement système qui appelle une fonction de type Callback, point barre, il n'y aucun code qui tourne en boucle infinie pendant l'attente, j'comprends pas...

Elle ressemble à quoi votre boucle infinie ? Je suis curieuse et interrogative et entrevois une incompréhension de votre part de comment fonctionne un composant réseau : ne me dite pas que vous faites une boucle sur IdTCPServer.Open, parce qu'a chaque fois que vous envoyez ou recevez des donnez vous faites un IdTCPServer.Close; ! :aie:
03/03/2016, 11h24
ShaiLeTroll

Citation:

Envoyé par LadyWasky

Un IdTCPServer maintenu actif, ok , pas de soucis, on ouvre la connexion (Open), mais grâce à une boucle infinie ??? Nan, jamais vu, il y a un truc qui cloche dans le "design" de votre appli.:

Dans une application Windows c'est TApplication.Run() qui fait la boucle !
Si tu ne mets pas de boucle Wait/PeekMessage, l'application s'arrête, il a peut-être fait comme dans le code que j'ai proposé un remplacement total du TApplication par une autre classe et dans ce cas, il faut écrire soit même la boucle

Du moins, j'espère que c'est bien cela ! :mouarf:
03/03/2016, 12h38
LadyWasky

Oui en effet, mais c'est bien la seule boucle infinie existante apparaissant dans une application Delphi.
03/03/2016, 12h52
Andnotor

Citation:

Envoyé par LadyWasky

Oui en effet, mais c'est bien la seule boucle infinie existante apparaissant dans une application Delphi.

On peut en avoir une par thread.
03/03/2016, 13h31
LadyWasky

Citation:

Envoyé par Andnotor

On peut en avoir une par thread.

J'y ai pensé aussi, mais en fait on peut s'en passer dans les thread la plupart du temps. La boucle infinie, c'est rare dans les threads.
03/03/2016, 14h36
Andnotor

Il n'y en a pas si le thread exécute une action unique mais il y en a une s'il est démarré périodiquement (par Event) ou qu'il sert de récepteur à des messages externes (GetMessage).
Mais rare en tout cas pas. Je dirais même que j'en utilise plus avec que sans ;)

Idem, mes threads hérités sont tous en boucle infinie à base de TEvent, WaitData, WaitMessage ... il passe 99% du temps à ne rien faire qu'à attendre le signal qui indique qu'il y a un élément dans une TThreadList ou qu'il faut éventuellement lancé un traitement en cas trop long délai d'inactivité, ou alors un traitement à période fixe.

ce qui donne ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
procedure TThreadHérité.Execute();
var
  wr: TWaitResult;
begin
  while not Terminated do
  begin
    wr := FSignal.WaitFor(FDelay);
    case wr of
      wrSignaled:
        begin
          if not Terminated then
            TraitementDeLaFileDAttente();
        end;
 
      wrTimeout:
        begin
          if not Terminated then
            Idle();
        end;
    end;
  end;
 
  Purge();
end;
 
//------------------------------------------------------------------------------
function TThreadHérité.AddBidule(Bidule: TTruc): Boolean;
var
  ItemPtr: PFile;
begin
  Result := False;
 
  if not Terminated and Assigned(FFileDAttente) and Assigned(FSignal) then
  begin
    New(ItemPtr);
    try
      ItemPtr^ := Bidule; // ici on recopie le paramètre complètement 
      FFileDAttente.Add(ItemPtr);
      Result := True;
    except
      Dispose(ItemPtr);
    end;
 
    if Result then
      FSignal.SetEvent()
  end;
end;
 
 
//------------------------------------------------------------------------------
procedure TThreadHérité.TerminatedSet();
begin
  inherited TerminatedSet();
 
  if Assigned(FSignal) then
    FSignal.SetEvent(); // Arrêt prématuré !
end;

En fait, maintenant pour un thread one shot, autant faire une méthode anonyme via TThread.CreateAnonymousThread