Discussion :

[benda95280]

Bonjour à tous,

J'ai récemment expérimenter les blocages avec Indy et les appels VCL.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
TLog = class(TIdSync)
        protected
            FMsg: String;
            procedure DoSynchronize; override;
        public
            constructor Create(const AMsg: String);
            class procedure AddMsg(const AMsg: String);
        end;
 
 
procedure TLog.DoSynchronize;
  begin
    Form2.AddInfoDebugger( 'RECEPTION', FMsg );
  end;
 
 
class procedure TLog.AddMsg( const AMsg : String );
  begin
    with Create( AMsg ) do
      try
        Synchronize;
      finally
        Free;
      end;
  end;
 
 
constructor TLog.Create( const AMsg : String );
  begin
    FMsg := AMsg;
    inherited Create;
  end;
 
 
  /// TFORM 2 ///
 
constructor TForm2.Create( AOwner : TComponent );
  begin
    inherited Create( AOwner );
    LoadIniConfiguration;
 
    IdTCPServer1.ContextClass := TMyContext;
    IdTCPServer1.DefaultPort := IndyServerPort;
    DictionaryMessage := TDictionaryMessage.Create;
 
    fSvrClose := False;
 
    if fileexists( SaveFileName )
    then
      DictionaryMessage.LoadFromFile( SaveFileName );
    UpdateListQuestions;
    if IndyAutoStart
    then
      StartStopIndyServer;
 
    // add info state debug save
    if DebugConfigState
    then
      LabelStateDebugSave.Caption :=
        'Sauvegarde des journaux sur disque: Activé'
    else
      LabelStateDebugSave.Caption :=
        'Sauvegarde des journaux sur disque: Désactivé';
 
  end;
 
 
procedure TForm2.FormClose(
  Sender     : TObject;
  var action : TCloseAction );
  var
    iA : integer;
    Context : TIdContext;
  begin
    if IdTCPServer1.Active
    then
    begin
      fSvrClose := true;
      IdTCPServer1.Active := False;
      fSvrClose := False;
    end;
 
  end;
 
// ******
// ******INDY procedures START*******//
// ******
 
 
procedure TForm2.StartStopIndyServer;
  begin
    if not IdTCPServer1.Active
    then
    begin
      IdTCPServer1.Active := true;
      Form2.AddInfoDebugger( 'ONLINE',
        'Server is now connected and ready to accept clients' );
      ListBoxClients.Clear;
      ListBoxClients.Items.Add( 'Serveur' );
      UpdateCountClients;
      Button1.Caption := 'Arret';
    end
    else
    begin
      fSvrClose := true;
      IdTCPServer1.Active := False;
      fSvrClose := False;
      ListBoxClients.Clear;
      Form2.AddInfoDebugger( 'Offline', 'Server is now disconnected' );
      Button1.Caption := 'Démarrer';
      UpdateCountClients;
    end;
  end;
 
 
procedure TForm2.tsConnect( AContext : TIdContext );
  begin
    with TMyContext( AContext ) do
    begin
      Con := Now;
      if ( Connection.Socket <> nil )
      then
        IP := Connection.Socket.Binding.PeerIP;
 
      Nick := Connection.IOHandler.ReadLn;
      if Nick <> ''
      then
      begin
        Connection.IOHandler.WriteLn( 'Welcome ' + Nick + '!' );
        ListBoxClients.Items.Add( Nick );
 
      end
      else
      begin
        Connection.IOHandler.WriteLn( 'No Nick provided! Goodbye.' );
        Connection.Disconnect;
      end;
    end;
  end;
 
 
procedure TForm2.tsExecute( AContext : TIdContext );
  var
    FMsg, FMSG2, FMSG3, msg, str, toname, filename, cmd, from,
      orsender : string;
    FStream, fstream2 : TFileStream;
    MStream : TMemoryStream;
    idx, posi, col : integer;
    Name1, Name2, Name3, MainStr : string;
    RXStreamRichedit, DictionaryMessageStream : TStringStream;
    LStreamSize : int64;
  begin
        //Empty for test//
  end;
 
 
procedure TForm2.tsDisconnect( AContext : TIdContext );
  begin
    AContext.Connection.Socket.InputBuffer.Clear;
    AContext.Connection.Disconnect;
    TLog.AddMsg( TMyContext( AContext ).Nick + ' Left the chat' );
    ListBoxClients.Items.Delete
      ( ListBoxClients.Items.IndexOf( TMyContext( AContext ).Nick ) );
  end;

Après pas mal de jours de recherche, et d'aide aussi, j'ai pu identifier qu'il s'agissait simplement de mon tsDisconnect, et plus précisément de mon ListBox.

J'ai donc appliqué ce qui suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
  TLog = class( TIdSync )
    protected
      FMsg : String;
      procedure DoSynchronize; override;
    public
      constructor Create( const AMsg : String );
      class procedure ProcessMsg( const AMsg : String );
  end;
 
 
procedure TLog.DoSynchronize;
var
posi: integer;
MsgCommand, ContentCommand: string;
  begin
    posi := Pos( '@', FMsg );
    MsgCommand := Copy( FMsg, 1, posi - 1 );
    ContentCommand := Copy( FMsg, Pos( '@', FMsg ) + 1, Length( FMsg ) - Pos( '@', FMsg ) );
 
    if MsgCommand = 'AddListBox' then
      Form2.ListBoxClients.items.Add( ContentCommand )
    else if MsgCommand = 'DelListBox' then
      Form2.ListBoxClients.Items.Delete(Form2.ListBoxClients.Items.IndexOf( ContentCommand ));
 
 
  end;
 
 
class procedure TLog.ProcessMsg( const AMsg : String );
  begin
    if not fSvrClose then
    begin
      with Create( AMsg ) do
        try
          Synchronize;
        finally
          Free;
        end;
    end;
  end;
 
 
constructor TLog.Create( const AMsg : String );
  begin
    FMsg := AMsg;
    inherited Create;
  end;

Et Modifié mon tsDisconnect par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
procedure TForm2.tsDisconnect( AContext : TIdContext );
  begin
    AContext.Connection.Socket.InputBuffer.Clear;
    AContext.Connection.Disconnect;
    TLog.ProcessMsg('DelListBox@'+TMyContext( AContext ).Nick);
  end;

Ma question est donc :
Est-ce la bonne façon de procéder ?
Est-il possible de faire plus simple ou claire ? (Que de passer par un string, qu'on explose, et analyse avant action)

[benda95280]

Personne ?

[Andnotor]

Dès lors que tu veux accéder à la VCL depuis un thread secondaire, tu dois synchroniser les appels (dans ton cas, tsDisconnect mais aussi tsConnect et tsExecute).

Après, la méthode dépend de ta version de Delphi. A l'heure actuelle, on privilégierait les procédures anonymes (TIdSync est de toute façon déprécié).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm2.tsConnect(AContext :TIdContext);
begin
  ...   
  if Nick <> '' then
  begin
    Connection.IOHandler.WriteLn( 'Welcome ' + Nick + '!' );
 
    TThread.Synchronize(procedure
                        begin
                          Form2.ListBoxClients.Items.Add(Nick);
                        end);
  end;
  ...
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure TForm2.tsDisconnect(AContext :TIdContext);
begin
  ...
  TThread.Synchronize(procedure
                      begin
                        with Form2.ListBoxClients.Items do
                          Delete(IndexOf(TMyContext(AContext).Nick));
                      end);
end;

Ça, c'est si tu veux (dois) être synchrone. L'autre option est bien sûr asynchrone par message (code non testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
const
  MY_CONNECTMSG = WM_USER;
 
type
  PConnectUser = ^TConnectUser;
  TConnectUser = record
    Active :boolean;
    User   :array[0..100] of char;
  end;
 
  TForm2 = class(TForm)
    procedure MyConnectMsg(var aMessage :TMessage); message MY_CONNECTMSG;
  end;
 
procedure SendConnectMsg(aActive :boolean; aUser :string);
var
  Data :PConnectUser;
  Wnd  :hWnd;
begin
  Wnd := FindWindow(...);
 
  if Wnd <> 0 then
  begin
    Data := VirtualAlloc(nil, SizeOf(TConnectUser), MEM_COMMIT, PAGE_READWRITE);
    Data.Active := aActive;
    StrPCopy(Data.User, aUser);
    PostMessage(Wnd, MY_CONNECTMSG, 0, LParam(Data));
  end;
end;
 
procedure TForm2.tsConnect(AContext :TIdContext);
begin
  ...   
  SendConnectMsg(TRUE, TMyContext(AContext).Nick);
end;
 
procedure TForm2.tsDisconnect(AContext :TIdContext);
begin
  ...
  SendConnectMsg(FALSE, TMyContext(AContext).Nick);
end;
 
procedure TForm2.MyConnectMsg(var aMessage :TMessage);
var
  Data :PConnectUser;
begin
  Data := pointer(aMessage.LParam);
 
  try
    if Data.Active 
    then ListBoxClient.Items.Add(Data.Nick)
    else ListBoxClients.Items.Delete(ListBoxClients.Items.IndexOf(Data.Nick);
  finally
    VirtualFree(Data, 0, MEM_RELEASE);
  end;
end;

VirtualAlloc plutôt que GetMem pour pouvoir éventuellement déporter le serveur dans une DLL.

Est-il possible de faire plus simple ou claire ? (Que de passer par un string, qu'on explose, et analyse avant action)

Autant déclarer deux paramètres (Active + User) comme la structure ci-dessus.