TBlockSerial : Stack Overflow à la connexion - Manque d'exemples

**JP CASSOU** · 05/02/2019, 09h50

Bjr à vous,

J'utilise le composant TBlockSerial pour connecter et commander un lasermètre Bluetooth (TLazSerial est inadapté) offant un port série COMx.
A la connexion, je rencontre une erreur 'Stack Overflow'.
Voici le code de la fonction de connexion, sachant que TPilotageDistoX est un descendant de TBlockSerial.
AfficherMessageErreur() et AfficherMessage() peuvent être remplacés par WriteLn() ou mockés (fonctions vides)

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
 
function TPilotageDistoX.OpenDistoXConnexion(const CommPort: string;
                                             const Baudrate: integer;
                                             const DataBits: integer;
                                             const StopBits: integer;
                                             const Parity  : char;
                                             const TimeOutInSecs: integer): boolean;
var
  EWE: Integer;
begin
  Result:= false;
  try
    AfficherMessageErreur(Format('%s.OpenDistoXConnexion sur %s', [ClassName, CommPort]));
    // Variables pour éviter un doublon dans les mesures
    FOldMesureType := 0;
    FOldMesureX    := 0;
    FOldMesureY    := 0;
    FOldMesureZ    := 0;
    FTimeOutInMilliseconds := TimeOutInSecs * 1000;
    self.Config(Baudrate, DataBits, Parity, StopBits, false, false);
    AfficherMessageErreur(Format('Baudrate: %d, DataBits: %d, StopBits: %d, Parity: "%s", TimeOut: %d sec', [Baudrate, DataBits, StopBits, Parity, TimeOutInSecs]));
    self.OnStatus := OnChangeSerialStatus;
    self.TestDSR  := True;
    self.Connect(CommPort);
    EWE := self.LastError;
    if (0 <> EWE) then AfficherMessageErreur(self.LastErrorDesc);
    Result := (0 = EWE);
    AfficherMessageErreur(Format('Connexion %s - ErrCode: %d - ErrDesc: %s', [IIF(0 = EWE, 'OK', 'KO'), self.LastError, LastErrorDesc]));
 
  except
    on E: Exception do
    begin
      AfficherMessageErreur(Format('Connexion sur port "%s" impossible (%s)', [self.Device, E.Message]));
    end;
  end;
end;

Par ailleurs, existe-il des exemples simples d'utilisation de TBLockSerial ?

Cdlt.

**tourlourou** · 05/02/2019, 10h51

Bonjour,

je lis ici :

procedure Config(baud, bits: integer; parity: char; stop: integer; softflow, hardflow: boolean); virtual;

Reconfigure communication parameters on the fly. You must be connected to port before!

Cela peut-il être en cause ?

**JP CASSOU** · 05/02/2019, 12h54

Envoyé par tourlourou

Bonjour,

je lis ici :

Cela peut-il être en cause ?

Ceci est corrigé. C'était bien en cause.

Maintenant, l'appareil que je dois piloter est lourdement propriétaire: format binaire, Bluetooth, fonctionnant sur requête-réponse, aucun exemple de programmation, ... et surtout une même commande 56 pour lire une zone mémoire à partir d'une adresse (voir documentation jointe)

**JP CASSOU** · 05/02/2019, 13h23

Bjr à tous,

Bon, j'arrive à me connecter à l'appareil.

Soit un buffer de 8 octets: type TBuffer8Bytes = array[0..7] of Byte;
que j'initialise avec des zéros.

J'envoie des commandes par:

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
 
procedure TPilotageDistoX.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word);
var
  MyBuffer: TBuffer8Bytes;
begin
  MyBuffer := MakeBuffer8BytesVierge();
  AfficherMessageErreur('Passe dans SendReadCommandAtAddress()');
  MyBuffer[0] := QCmd;           // envoi de la commande
  MyBuffer[2] := Lo(QAddress);   // QAddress and $FF         // envoi de la première partie de l'adresse   //  Address & 0xFF
  MyBuffer[3] := Hi(QAddress);   // (QAddress shr 8) and $FF //   envoi de la première partie de l'adresse // (Address >> 8) & 0xFF
  // Stack overflow
  AfficherMessageErreur('001');
  AfficherMessageErreur(Format('SendBuffer: %d', [SendBuffer(@MyBuffer, 3)]));
 
  AfficherMessageErreur('002');       
end;

Lors de l'envoi de ces trois octets (un opcode + les deux parties d'une adresse) --> crash ou StackOverflow. Toujours en erreur: Stack overflow, crash, gel définitif.

La fonction qui bloque est TBlockSerial.SendBuffer()
J'ai essayé:
self.RTS := true;
self.TestCTS := True;
self.TestDSR := True;

Rien à faire

Comment peut-on travailler avec ces bugs inconstants ??? C'est insupportable !!!

Plus sérieusement, y a-t-il des composants tout faits pour la gestion du port série en binaire ?

Je songe à sous-traiter ce développement parce que là, çà me GONFLE SERIEUSEMENT.

==========================
JP CASSOU
Spéléologue
Athéiste militant (ultra-laïciste)

**JP CASSOU** · 05/02/2019, 18h08

Ce code bloque dans la fonction ReadAnPacket():

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
 
unit unitDistoX2;
// By JP CASSOU under Licence GPL
{$INCLUDE CompilationParameters.inc}
 
interface
 
uses
  Classes, SysUtils, Math, dateutils,
  StructuresDonnees,
  Common
  {$IFDEF USE_GENERIC_TYPES}
  ,UnitListesSimplesWithGeneriques
  {$ELSE}
  UnitListesSimplesWithoutGeneriques
  {$ENDIF}
  , LazSerial, LazSynaSer, LazSerialPort
  ;
 
const
  // axes
  mrX_AXIS = 1;
  mrY_AXIS = 2;
  mrZ_AXIS = 3;
  // mappage de la mémoire du DistoX
  //ADDR_START_SECTION_CONFIGURATION   = $B000; // calibration coefficients, Ox00B000 -> Ox00B3FF
  //ADDR_START_SECTION_DATA_STORE      = $B400; // data segment            , Ox00B400 -> Ox00FFFF
  // commandes DistoX
  DISTOX_COMMAND_EXTINCTION             =  52;  // $34: extinction du Disto
  DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS =  56;  // $38: b111000 ; conflict with measure trigging command
  DISTOX_COMMAND_CALIBRATION_ON         =  49;  // $31: b110001: Calibration ON
  DISTOX_COMMAND_CALIBRATION_OFF        =  48;  // $30: b110000: Calibration OFF
  DISTOX_COMMAND_LASER_ON               =  54;  // $36: b110110: Laser ON
  DISTOX_COMMAND_LASER_OFF              =  55;  // $37: b110111: Laser OFF
  //DISTOX_COMMAND_BEEP_ON                = $33;  // $33: Silent ON  = à ne pas utiliser
  //DISTOX_COMMAND_BEEP_OFF               = $32;  // $33: Silent OFF
  DISTOX_COMMAND_READ_DATA_SHOT         =  56;  // $38: lecture d'une visée
  DISTOX_COMMAND_BOOTLOADER_READ_DATA_AT_ADDRESS =  58;  // $38: b111010 ; conflict with measure trigging command
 
  ERR_MSG_NO_CONNEXION                  = '** No Connexion **';
 
type TBuffer8BytesOfData = array[0..7] of Byte;
 
 
 
type
 
{ TPilotageDistoX2 }
 
 TPilotageDistoX2 = class(TLazSerial)
  private
    // Mode d'attente des données
    FOnOffAttenteDonneesRX: boolean;
    // Infos sur le matos: Tout à -1
    FDistoXSerialNumber     : integer;
    FDistoXVersionFirmware  : integer;
    FDistoXVersionHardware  : Integer;
    procedure EvenementSerialRxData(Sender: TObject);
    procedure EvenementSerialStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
 
 
    function ReadAnPacket(const QAddr: word; var QBuffer: TBuffer8BytesOfData): boolean;
 
    // fonctions d'écriture/lecture
    function  ReadBufferAtAddress(const QAddr: integer;
                                  var MyBuffer: TBuffer8BytesOfData): boolean;
    function  ReadBuffer8bytes(var MyBuffer: TBuffer8BytesOfData;
                               out LastSerialError: integer;
                               out QTypeData: byte;
                               out QOp      : byte): TProtoSerialError;
    procedure SendReadCommandAtAddress(var MyBuffer: TBuffer8BytesOfData; const QCmd: word; const QAddress: word);
 
  public
    function  Initialiser(): boolean;
    procedure Finaliser();
    function  OpenDistoX(const CommPort: string): boolean;
    procedure CloseDistoX();
    // Infos sur le matériel
    function ExtractNumSerieFromDistoX(): integer;
    function ExtractVersionFirmWareFromDistoX(): integer;
    function ExtractVersionHardwareFromDistoX(): integer;
 
    // événements
 
 
end;
 
implementation
uses
  Forms;   // pour Application
 
{ TPilotageDistoX2 }
////////////////////////////////////////////////////////////////////////////////
function MakeBufferVierge(): TBuffer8BytesOfData;
var
  q: Integer;
begin
  for q := 0 to High(Result) do Result[q] := $0;
end;
 
function TPilotageDistoX2.Initialiser(): boolean;
begin
  Result := false;
  AfficherMessage(Format('%s.Initialiser',[self.ClassName]));
  result := False;
  FOnOffAttenteDonneesRX := false;
  FDistoXSerialNumber    := -1;
  FDistoXVersionFirmware := -1;
  FDistoXVersionHardware := -1;
  try
    Result := True;
  finally
  end;
end;
 
procedure TPilotageDistoX2.Finaliser();
begin
  try
    AfficherMessage(Format('%s.Finaliser',[self.ClassName]));
  finally
  end;
end;
 
function TPilotageDistoX2.OpenDistoX(const CommPort: string): boolean;
begin
  Result := False;
  ClearConsole();
  ClearConsoleErreur();
  AfficherMessage(Format('%s.OpenDistoX sur %s',[self.ClassName, CommPort]));
  try
    self.Device        := CommPort;       
    self.Open;
    self.OnRxData      := EvenementSerialRxData;
    self.OnStatus      := EvenementSerialStatus;
 
    Result := True;
    AfficherMessageErreur('DistoX connecté sur ' + CommPort);
 
    ExtractVersionFirmWareFromDistoX();
    ExtractVersionHardwareFromDistoX();
    ExtractNumSerieFromDistoX();
 
  except
    on E: Exception do AfficherMessageErreur(Format('Connexion sur port "%s" impossible' + #13#10 + 'Message: %s', [self.Device, E.Message]));
  end;
end;
 
procedure TPilotageDistoX2.CloseDistoX();
begin
  AfficherMessage(Format('%s.CloseDistoX',[self.ClassName]));
  try
    self.Close;
  finally
  end;
end;
////////////////////////////////////////////////////////////////////////////////
// Evenements
procedure TPilotageDistoX2.EvenementSerialRxData(Sender: TObject);
begin
  //if (FOnOffAttenteDonneesRX) then LireEtDepilerTrameDe8OctetsData();
end;
 
 
 
procedure TPilotageDistoX2.EvenementSerialStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
begin
  AfficherMessageErreur(Self.SynSer.Device);
  begin
    case Reason of
      HR_SerialClose : AfficherMessage('Port ' + Value + ' closed');
      HR_Connect     : AfficherMessage('Port ' + Value + ' connected');
      //HR_CanRead     : AfficherMessage('CanRead : ' + Value);
      //HR_CanWrite    : AfficherMessage('CanWrite : ' + Value);
      //HR_ReadCount   : AfficherMessage('ReadCount : ' + Value);
      //HR_WriteCount  : AfficherMessage('WriteCount : ' + Value);
      HR_Wait        : AfficherMessage('Wait : ' + Value);
 
    end ;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
// Infos sur le matériel
// numéro de série du DistoX
function TPilotageDistoX2.ExtractNumSerieFromDistoX(): integer;
var
  MyBuffer: TBuffer8BytesOfData;
begin
  Application.ProcessMessages;
  if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
  begin
    if (ReadBufferAtAddress($8008, MyBuffer)) then  FDistoXSerialNumber := MyBuffer[3] + MyBuffer[4] shl 8; // retourne 2395 ou 2329 pour les DistoX de JPC
  end;
  Result := FDistoXSerialNumber;
end;
// version de firmware
function TPilotageDistoX2.ExtractVersionFirmWareFromDistoX(): integer;
var
  MyBuffer: TBuffer8BytesOfData;
begin
  Application.ProcessMessages;
  if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
  begin
    if (ReadBufferAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
  end;
  Result := FDistoXVersionFirmware;
end;
// version de hardware
function TPilotageDistoX2.ExtractVersionHardwareFromDistoX(): integer;
var
  MyBuffer: TBuffer8BytesOfData;
begin
  Application.ProcessMessages;
  if (FDistoXVersionHardware = -1) then
  begin
    if (ReadBufferAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
  end;
  Result := FDistoXVersionHardware;
end;
//********************************************************************************
// lecture-écriture
procedure TPilotageDistoX2.SendReadCommandAtAddress(var MyBuffer: TBuffer8BytesOfData;const QCmd: word; const QAddress: word);
begin
  MyBuffer[0] :=  QCmd;                        //DISTOX_COMMAND_READ_DATA = 56; // 00111000
  MyBuffer[1] :=  QAddress and $FF;           //  Address & 0xFF
  MyBuffer[2] := (QAddress shr 8) and $FF;    // (Address >> 8) & 0xFF
  self.WriteBuffer(MyBuffer, 3); //1 + High(MyBuffer));  // WriteBuffer() command
end;
function TPilotageDistoX2.ReadAnPacket(const QAddr: word; var QBuffer: TBuffer8BytesOfData): boolean;
var
   reply_addr, QLastSerialError: Integer;
   QTypeData, QOp: byte;
begin
  Result   := false;
  if (not self.Active) then Exit;
  QBuffer := MakeBufferVierge();
  SendReadCommandAtAddress(QBuffer, DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddr);
  if (PROTO_OK = ReadBuffer8bytes(QBuffer, QLastSerialError, QTypeData, QOp)) then
  begin
    if (QBuffer[0] = DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS) then
    begin
      // contrôle de l'adresse lue
      reply_addr := (QBuffer[2] shl 8) OR QBuffer[1];
      Result := (reply_addr = QAddr);
      Result := True;
    end;
  end;
  //Application.ProcessMessages();
end;
 
function TPilotageDistoX2.ReadBufferAtAddress(const QAddr: integer; var MyBuffer: TBuffer8BytesOfData): boolean;
begin
  result := False;
  try
    // on boucle tant que la lecture des paquets n'a pas réussi
    while (not ReadAnPacket(QAddr, MyBuffer)) do // AfficherMessageErreur(Format('%s.ReadBufferAtAddress: %s: %s', [self.ClassName, {$I %FILE%}, {$I %LINE%}]));
      ;
    Result := True;
  except
    //FDistoXSerialNumber := -1;
  end;
 
end;
 
function TPilotageDistoX2.ReadBuffer8bytes(var MyBuffer: TBuffer8BytesOfData; out LastSerialError: integer; out QTypeData: byte; out QOp: byte): TProtoSerialError;
begin
 
end;
 
end.

Cdlt

=====================================================
JP CASSOU
Spéléologue

**anapurna** · 06/02/2019, 08h32

Salut

Ta boucle while

Code :

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

1
2
while (not ReadAnPacket(QAddr, MyBuffer)) do // AfficherMessageErreur(Format('%s.ReadBufferAtAddress: %s: %s', [self.ClassName, {$I %FILE%}, {$I %LINE%}]));
      ;

ne sert à rien sinon à planter ta machine... En regardant le code de tblock... tu as un waitingdata qui le fait pour toi.

Regarde ce bout de code, je le trouve assez parlant.
Tu testes le lasterror, tu demandes si tu peux lire et ensuite tu lis :

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
program serialcollex;
 
{$APPTYPE CONSOLE}
 
 uses
  synaser,
  sysutils;
 
var
   ser:TBlockSerial;
   LCMD:String;
 begin
   ser:=TBlockserial.Create;
   try
     ser.RaiseExcept:=true;
     ser.Connect('COM1');
     ser.Config(9600,8,'N',0,false,false);
 
     while not (ser.LastError <> 0) do 
     begin
         if ser.lastError<>0 then 
           break;
           if ser.canread(1000) then  
           begin
              LCMD := ser.Recvstring(1000);
              writeLn(LCMD);
           end;
     end;
 
   finally
     ser.Free;
   end;
 end.

TBlockSerial : Stack Overflow à la connexion - Manque d'exemples

Lazarus Pascal

Vue hybride

Discussions similaires

Partager

Partager