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

Version imprimable

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:

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.

05/02/2019, 10h51
tourlourou

Bonjour,

je lis ici :

Citation:

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 ?
05/02/2019, 12h54
JP CASSOU

1 pièce(s) jointe(s)

OK pour la connexion mais d'autres gros problèmes ensuite

Citation:

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)

TBlockSerial: Cà commence à me gonfler grave

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:

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)

Nouvelle version avec TLazSerial: KO - A voir avec l'auteur de TLazSerial

Ce code bloque dans la fonction ReadAnPacket():

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
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

Salut

Ta boucle while

Code:

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:

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: Cà avance pas mal grâce à Annapurna

Bjr à vous,

Avec un conseil de Annapurna, j'ai pu débloquer pas mal de pbs pour mon projet de terminal de terrain utilisant un DistoX.
Le code ci-dessous fonctionne bien

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
 
program TestCOM;
 
{$APPTYPE CONSOLE}
 
uses
synaser,
sysutils,
UnitMinimalCOM
;
 
var
MyMesureVisee: TMesureViseeDistoX;
MyDistoX2Connexion: TDistoX2Connexion;
begin
  MyDistoX2Connexion := TDistoX2Connexion.Create;
  try
    if (MyDistoX2Connexion.Initialiser('COM10', 5)) then
    begin
      WriteLn(MyDistoX2Connexion.GetDescriptionDevice());
      while not (MyDistoX2Connexion.GetLastError() <> 0) do
      begin
        if (0 <> MyDistoX2Connexion.GetLastError()) then break;
        if (MyDistoX2Connexion.LireEtDecoderBuffer8Bytes(MyMesureVisee)) then
        begin
          WriteLn(Format('L = %.3f m; Az = %.2f; P = %.2f - EWE = %s',
                                         [myMesureVisee.Longueur,
                                          myMesureVisee.Azimut,
                                          myMesureVisee.Pente,
                                          myMesureVisee.HexaData
                                          ]));
 
        end;
        // quitter avec une visée courte et verticale
        if ((MyMesureVisee.Longueur < 0.20) and (Abs(MyMesureVisee.Pente) > 85)) then
        begin
          WriteLn('Visee de signalisation d''arret');
          break;
        end;
      end;
 
    end;
    MyDistoX2Connexion.Finaliser();
  finally
    FreeAndNil(MyDistoX2Connexion);
  end;
end.

L'unité encapsulant la connexion DistoX

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
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
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
 
unit UnitMinimalCOM;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, math,
  synaser;
const
  FV = 24000.00;
  FM = 16384.00;
 
  MAX_IT = 500;
  EPS    = 1E-8;
  HEX_TO_RAD = 2 * PI / 65536;
 
  INVALID_HANDLE_VALUE = THandle(-1);
 
  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
 
 
// pour le DistoX
type TNumeroSerie = integer;
type TTypeMesureDistoX = (tmdxUNKNOWN, tmdxCHEMINEMENT, tmdxLRUD, tmdxANTENNE, tmdxSIGNALISATION);
type TPoint3Df = record x, y, z : double; end;
 
type TMesureViseeDistoX = record
  TypeMesure : TTypeMesureDistoX;
  DistoXSerialNumber: integer;
  SerieCourante  : TNumeroSerie;
  StationCourante: integer;
  Block      : integer;
  Segment    : integer;
  Longueur   : double;
  Azimut     : double;
  Pente      : double;
  IsMarked   : boolean;
  HexaData   : string;
  TimeStamp  : TDateTime; // horodatage de la visée
end;
type TBuffer8Bytes = array[0..7] of byte;
 
 
 
type
 
{ TDistoX2Connexion }
 
 TDistoX2Connexion = class(TBlockSerial)
  private
    FDistoXSerialNumber     : integer;
    FDistoXVersionFirmware  : integer;
    FDistoXVersionHardware  : integer;
 
    FOldType: integer;
    FOldX   : integer;
    FOldY   : integer;
    FOldZ   : Integer;
    FTimeOutInMilliseconds: integer;
    function Acknowledge(const QTypeData: byte): boolean;
    function ExtractNumSerieFromDistoX(): integer;
    function ExtractVersionFirmWareFromDistoX(): integer;
    function ExtractVersionHardwareFromDistoX(): integer;
    function SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
    function ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
  public
    function  Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
    procedure Finaliser();
    function LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
    function GetLastError(): integer;
    function GetDescriptionDevice(): string;
 
 
 
end;
 
 
 
implementation
function MakeEmptyTBuffer8Bytes(): TBuffer8Bytes;
var
  i: Integer;
begin
  for i := 0 to High(Result) do Result[i] := 0;
end;
 
{ TDistoX2Connexion }
 
function TDistoX2Connexion.Acknowledge(const QTypeData: byte): boolean;
var
  MyByte: Byte;
begin
  result := false;
  if (self.CanWrite(FTimeOutInMilliseconds)) then
  begin
    MyByte := (QTypeData and $80) or $55;
    self.SendByte(MyByte);
    Result := (0 = self.LastError);
  end;
end;
 
function TDistoX2Connexion.Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
 
begin
  result := false;
  WriteLn(Format('%s.Initialiser(): Port "%s" - TimeOut: %d secondes)', [self.ClassName, DeviceCom, TimeOutInSecondes]));
  FTimeOutInMilliseconds := 1000 * TimeOutInSecondes;
 
  FDistoXSerialNumber    := -1;
  FDistoXVersionFirmware := -1;
  FDistoXVersionHardware := -1;
  FOldType := 0;
  FOldX    := 0;
  FOldY    := 0;
  FOldZ    := 0;
 
 
 
 
  Self.RaiseExcept:=true;
  Self.Connect(DeviceCom);
  self.Config(9600, 8, 'N', 0, false, false);
  WriteLn('Connexion OK');
  Result := (0 = self.LastError);
 
end;
 
procedure TDistoX2Connexion.Finaliser();
begin
  WriteLn(Format('%s.Finaliser("%s")', [self.ClassName, self.GetDescriptionDevice()]));
  try
    self.CloseSocket;
  finally
  end;
end;
// Dans cette fonction, on extrait une trame de 8 octets
// S'il s'agit de données de mesures topo, on acquitte.
// En cas de succès de l'acquittement, on décode
// En cas de succès du décodage, l'appelant peut utiliser la visée
function TDistoX2Connexion.LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
var
  EWE: String;
  i: Integer;
  MyBuffer : TBuffer8Bytes;
  QTypeData, QOp: Byte;
  QX, QY, QZ, Dist: integer;
  P: float;
begin
  Result := false;
  if (self.CanRead(FTimeOutInMilliseconds)) then
  begin
    try
      self.RecvBuffer(@MyBuffer, 8);
 
      MyMesureVisee.TypeMesure := tmdxUNKNOWN;
      MyMesureVisee.Longueur := 0.00;
      MyMesureVisee.Azimut   := 0.00;
      MyMesureVisee.Pente    := 0.00;
      MyMesureVisee.IsMarked := false;
      MyMesureVisee.HexaData := '';
      EWE := '';
      for i := 0 to 7 do EWE += Format('%.2X', [MyBuffer[i]]);
      QTypeData := MyBuffer[0];
      QOp       := (QTypeData and $3F);
      // Ce sont des données ?
      if (QOp < $20) then
      begin
        if (Acknowledge(QTypeData)) then   // Indispensable juste après le test (QOp < $20), sinon, KO
        begin
          QX := MyBuffer[1] + (MyBuffer[2] shl 8);
          QY := MyBuffer[3] + (MyBuffer[4] shl 8);
          QZ := MyBuffer[5] + (MyBuffer[6] shl 8);
 
          if ((Foldtype <> QTypeData) and (FoldX    <> QX) and (FoldY    <> QY) and (FoldZ <> QZ)) then
          begin
            case QOp of
              1: // données topo
              begin
               // distances exprimées en mm si < 100 m, sinon en cm
               Dist := QX + ((QTypeData and $40) shr 10);     // OK
               //myMesureVisee.TypeMesure := op;
               myMesureVisee.TypeMesure := tmdxUNKNOWN;
               myMesureVisee.Longueur := Dist * 0.001; // TODO: Cas où Dist > 100 m
               myMesureVisee.Azimut   := radtodeg(QY * HEX_TO_RAD);                   // OK
               P  := radtodeg(QZ * HEX_TO_RAD);
               // if (Not InRange(P, -0.001, (90.001)) then P := P - 360.00;
               if (Not InRange(P, -0.001, 0.25 * 360.00 + 0.001)) then P := P - 360.00;
               myMesureVisee.Pente := P;
               myMesureVisee.HexaData := EWE;
               myMesureVisee.TimeStamp:= Now();
 
               Result := True;
              end;
              2, 3: ; // G et M, ne fonctionne pas
              4: ;
            else
              ;
            end;
            Foldtype := QTypeData;
            FoldX    := QX;
            FoldY    := QY;
            FoldZ    := QZ;
          end; // if ((Foldtype <> QTypeData) and (FoldX ...
        end; //  if (Acknowledge(qtype) = PROTO_OK)) then
      end; // if (QOp < $20) then
    except
    end;
  end;
end;
 
function TDistoX2Connexion.GetLastError(): integer;
begin
  result := self.LastError;
end;
 
function TDistoX2Connexion.GetDescriptionDevice(): string;
begin
  Result := Format('Device: %d - Hardware: %d - Firmware: %d',
                   [ExtractNumSerieFromDistoX(),
                    ExtractVersionHardwareFromDistoX(),
                    ExtractVersionFirmWareFromDistoX()
                   ]);
end;
// Fonctions bas niveau de lecture/écriture
function TDistoX2Connexion.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
var
  MyBuffer: TBuffer8Bytes;
begin
  MyBuffer := MakeEmptyTBuffer8Bytes();
  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.SendBuffer(@MyBuffer, 3);
  result := (0 = self.LastError);
end;
 
function TDistoX2Connexion.ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
begin
  result := false;
  MyBuffer := MakeEmptyTBuffer8Bytes();
  if (SendReadCommandAtAddress(DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddress)) then
  begin
    self.RecvBuffer(@MyBuffer, 8);
    Result := (0 = self.LastError);
  end;
end;
 
// numéro de série du DistoX
function TDistoX2Connexion.ExtractNumSerieFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($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 TDistoX2Connexion.ExtractVersionFirmWareFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
  end;
  Result := FDistoXVersionFirmware;
end;
// version de hardware
function TDistoX2Connexion.ExtractVersionHardwareFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXVersionHardware = -1) then
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
  end;
  Result := FDistoXVersionHardware;
end;
end.

Et un exemple de sortie:

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
 
TDistoX2Connexion.Initialiser(): Port "COM10" - TimeOut: 5 secondes)
Connexion OK
Device: 2395 - Hardware: 1248 - Firmware: 205
L = 1,077 m; Az = 180,62; P = -17,07 - EWE = 0135047080DDF3F9
L = 1,166 m; Az = 180,01; P = -16,23 - EWE = 018E04028076F4FA
L = 1,132 m; Az = 153,73; P = -39,18 - EWE = 016C04516D23E4EA
L = 1,206 m; Az = 126,88; P = -36,55 - EWE = 01B604395A03E6D6
L = 1,167 m; Az = 314,48; P = -1,13 - EWE = 018F04A1DF33FF20
L = 1,214 m; Az = 323,47; P = 4,10 - EWE = 01BE0406E6EA021D
L = 1,333 m; Az = 336,37; P = 3,19 - EWE = 01350532EF440219
L = 1,564 m; Az = 349,66; P = 3,01 - EWE = 011C06A6F8240215
L = 1,895 m; Az = 0,16; P = 3,01 - EWE = 0167071E00240213
L = 1,199 m; Az = 325,00; P = -0,26 - EWE = 01AF041DE7D0FF2D
L = 1,439 m; Az = 268,80; P = -2,48 - EWE = 019F0525BF3CFE4B
L = 1,650 m; Az = 261,03; P = 2,09 - EWE = 0172069FB97D014B
L = 1,152 m; Az = 300,47; P = -6,82 - EWE = 018004AAD526FB25
L = 1,084 m; Az = 310,97; P = 7,72 - EWE = 013C0423DD7E0508
L = 1,103 m; Az = 320,42; P = 3,89 - EWE = 014F04DBE3C40208
L = 1,446 m; Az = 351,56; P = 7,92 - EWE = 01A605FFF9A105FE
L = 0,127 m; Az = 202,70; P = -83,69 - EWE = 017F0024907CC429
L = 0,610 m; Az = 47,59; P = -68,81 - EWE = 016202D72112CFF7
L = 0,129 m; Az = 47,53; P = -89,24 - EWE = 018100CC218AC0C3
Visee de signalisation d'arret
TDistoX2Connexion.Finaliser("Device: 2395 - Hardware: 1248 - Firmware: 205")

;)

TBlockSerial: Comment utiliser OnStatus ?

Bjr

Cà avance bien avec TBlockserial mais j'ai encore des problèmes avec OnStatus, que je n'arrive pas à utiliser (documentation difficile à trouver = doc inexistante en pratique)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 procedure TMainFormPilote.ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string); begin AfficherMessage('ProcStatus'); end; ... function TMainFormPilote.Initialiser(): boolean; var Reason: THookSerialReason; begin Result := false; FConnexionDistoX := TDistoX2Connexion.Create; FConnexionDistoX.OnStatus := ProcHookStatus; // <-- Error: Wrong parametees
cdlt

--------------------------------------------------------------------
JP CASSOU
Spéléologue
Athéiste* militant - Christianophobe déclaré - Islamophobe

*Un athéiste est un athée qui milite pour une politique publique d'interdiction totale et de répression des religions

Salut

Tu reprends bien pourtant la définition :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 {:Possible status event types for @link(THookSerialStatus)} THookSerialReason = ( HR_SerialClose, HR_Connect, HR_CanRead, HR_CanWrite, HR_ReadCount, HR_WriteCount, HR_Wait ); {:procedural prototype for status event hooking} THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason; const Value: string) of object;
Ce serait peut être dû au fait que la propriété soit published et pas public dans les descendants, je ne sais pas l’impact que cela peut avoir.

TLazSerial: Solutionnement en vue ?

Bjr,

Je reteste en dérivant mon TDistoX de TLazserial.
Cà commence à bien marcher mais à la déconnexion, j'ai un message d'erreur 'Fonction incorrecte (code d'erreur -1)

Le pilote:

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
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
 
unit PiloteDistoX2MainFrm;
 
{$mode delphi}{$H+}
 
interface
 
uses
  UnitMinimalCOM,
  synaser, LazSerial,
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, curredit, SynEdit, LazSynaSer;
 
type
 
  { TMainFormPilote }
 
  TMainFormPilote = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    editTimeOut: TCurrencyEdit;
    editPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    SynEdit1: TSynEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
 
  private
    FConnexionDistoX: TDistoX2Connexion;
    procedure AfficherMessage(const Msg: string);
    procedure ProcOnRXData(Sender: TObject);
 
  public
    function Initialiser(): boolean;
    procedure Finaliser();
  end;
 
var
  MainFormPilote: TMainFormPilote;
 
implementation
 
{$R *.lfm}
 
{ TMainFormPilote }
 
//procedure(Sender: TObject; Reason: THookSerialReason; const Value: string) of object;
procedure TMainFormPilote.ProcOnRXData(Sender: TObject);
var
  MyMesureVisee: TMesureViseeDistoX;
begin
  FConnexionDistoX.LireEtDecoderBuffer8Bytes(MyMesureVisee);
  // On vire les visées de longueur nulle (qui seront rejetées par GHTopo de toutes façons
  if (MyMesureVisee.Longueur > 0.001) then
  begin
    //... traitements
    AfficherMessage(Format('%d: %f, %f, %f', [MyMesureVisee.DistoXSerialNumber, MyMesureVisee.Longueur, MyMesureVisee.Azimut, MyMesureVisee.Pente]));
  end;
 
 
 
end;
 
procedure TMainFormPilote.ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
var
  MyMesureVisee: TMesureViseeDistoX;
begin
  case Reason of
    HR_SerialClose:
      begin
        AfficherMessage('Connexion terminée');
      end;
    HR_Connect:
      begin
        AfficherMessage('Connexion en cours');
      end;
    HR_CanRead:
      begin
        //AfficherMessage('Lecture possible');
 
      end;
    HR_CanWrite:
      begin
        //AfficherMessage('Ecriture possible');
      end;
    HR_ReadCount:
      begin
        //AfficherMessage('Read count');
 
      end;
    HR_WriteCount:
      begin
        //AfficherMessage('Write count');
      end;
    HR_Wait:
      begin
        // AfficherMessage('En attente');
 
      end;
  end;
end;
 
function TMainFormPilote.Initialiser(): boolean;
var
  Reason: THookSerialReason;
begin
  Result := false;
  FConnexionDistoX := TDistoX2Connexion.Create(self);
  FConnexionDistoX.OnStatus := ProcHookStatus;
  FConnexionDistoX.OnRxData := ProcOnRXData;
  editPort.Text         := 'COM10';
  editTimeOut.AsInteger := 10;
  SynEdit1.Clear;
end;
 
procedure TMainFormPilote.Finaliser();
begin
  try
  finally
    FreeAndNil(FConnexionDistoX);
  end;
end;
 
procedure TMainFormPilote.Button1Click(Sender: TObject);
begin
  if (FConnexionDistoX.Initialiser(Trim(editPort.Text), editTimeOut.AsInteger)) then
  begin
    AfficherMessage(FConnexionDistoX.GetDescriptionDevice());
  end
  else
  begin
    AfficherMessage('Echec de connexion');
  end;
end;
 
procedure TMainFormPilote.Button2Click(Sender: TObject);
begin
  //FConnexionDistoX.CloseSocket;
  FConnexionDistoX.Active:= false;
end;
 
procedure TMainFormPilote.Button3Click(Sender: TObject);
begin
  FConnexionDistoX.DemanderUneMesure();
end;
 
procedure TMainFormPilote.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  self.Finaliser();
end;
 
procedure TMainFormPilote.FormShow(Sender: TObject);
begin
  self.Initialiser();
end;
procedure TMainFormPilote.AfficherMessage(const Msg: string);
begin
  SynEdit1.Lines.add(Msg);
 
end;
end.

L'unité:

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
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
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
 
unit UnitMinimalCOM;
 
{$mode delphi}{$H+}
 
interface
 
uses
  Classes, SysUtils, math,
  LazSerial,
  synaser;
const
  FV = 24000.00;
  FM = 16384.00;
 
  MAX_IT = 500;
  EPS    = 1E-8;
  HEX_TO_RAD = 2 * PI / 65536;
 
  INVALID_HANDLE_VALUE = THandle(-1);
 
  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_TRIG_DATA_SHOT         =  56;  // $38: lecture d'une visée
  DISTOX_COMMAND_BOOTLOADER_READ_DATA_AT_ADDRESS =  58;  // $38: b111010 ; conflict with measure trigging command
 
 
// pour le DistoX
type TNumeroSerie = integer;
type TTypeMesureDistoX = (tmdxUNKNOWN, tmdxCHEMINEMENT, tmdxLRUD, tmdxANTENNE, tmdxSIGNALISATION);
type TPoint3Df = record x, y, z : double; end;
 
type TMesureViseeDistoX = record
  TypeMesure : TTypeMesureDistoX;
  DistoXSerialNumber: integer;
  SerieCourante  : TNumeroSerie;
  StationCourante: integer;
  Block      : integer;
  Segment    : integer;
  Longueur   : double;
  Azimut     : double;
  Pente      : double;
  IsMarked   : boolean;
  HexaData   : string;
  TimeStamp  : TDateTime; // horodatage de la visée
end;
type TBuffer8Bytes = array[0..7] of byte;
 
 
 
type
 
{ TDistoX2Connexion }
 
 //TDistoX2Connexion = class(TBlockSerial)
  TDistoX2Connexion = class(TLazSerial)
 
 
  private
    FCommPort               : string;
    FDistoXSerialNumber     : integer;
    FDistoXVersionFirmware  : integer;
    FDistoXVersionHardware  : integer;
 
    FOldType: integer;
    FOldX   : integer;
    FOldY   : integer;
    FOldZ   : Integer;
    FTimeOutInMilliseconds: integer;
 
 
    function Acknowledge(const QTypeData: byte): boolean;
    function ExtractNumSerieFromDistoX(): integer;
    function ExtractVersionFirmWareFromDistoX(): integer;
    function ExtractVersionHardwareFromDistoX(): integer;
    function SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
    function ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
  public
    function  Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
    procedure Finaliser();
    function LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
    function GetLastError(): integer;
    function GetDescriptionDevice(): string;
    procedure DemanderUneMesure();
 
end;
 
 
 
implementation
uses
  Dialogs;
function MakeEmptyTBuffer8Bytes(): TBuffer8Bytes;
var
  i: Integer;
begin
  for i := 0 to High(Result) do Result[i] := 0;
end;
 
{ TDistoX2Connexion }
 
function TDistoX2Connexion.Acknowledge(const QTypeData: byte): boolean;
var
  MyByte: Byte;
begin
  result := false;
  if (self.SynSer.CanWrite(FTimeOutInMilliseconds)) then
  begin
    MyByte := (QTypeData and $80) or $55;
    self.SynSer.SendByte(MyByte);
    Result := (0 = self.synser.LastError);
  end;
end;
 
function TDistoX2Connexion.Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
 
begin
  ShowMessage(Format('Device: %s - Timeout: %d', [DeviceCom, TimeOutInSecondes]));
  result := false;
  // fermeture
  //self.CloseSocket;
  //WriteLn(Format('%s.Initialiser(): Port "%s" - TimeOut: %d secondes)', [self.ClassName, DeviceCom, TimeOutInSecondes]));
  FTimeOutInMilliseconds := 1000 * TimeOutInSecondes;
 
  FCommPort := DeviceCom;
  FDistoXSerialNumber    := -1;
  FDistoXVersionFirmware := -1;
  FDistoXVersionHardware := -1;
  FOldType := 0;
  FOldX    := 0;
  FOldY    := 0;
  FOldZ    := 0;
  Self.SynSer.RaiseExcept:=true;
  //Self.Connect(FCommPort);
  self.Device := FCommPort;
  self.BaudRate := br__9600;
  self.DataBits := db8bits;
  self.Parity   := pNone;
  self.StopBits := sbOne;
  ShowMessage('666');
  self.Open;
 
  //self..Config(9600, 8, 'N', 0, false, false);
 
 
  //WriteLn('Connexion OK');
  Result := (0 = self.SynSer.LastError);
 
end;
 
procedure TDistoX2Connexion.Finaliser();
begin
  //WriteLn(Format('%s.Finaliser("%s")', [self.ClassName, self.GetDescriptionDevice()]));
  try
    //self.CloseSocket;
    self.Close;
  finally
  end;
end;
// Dans cette fonction, on extrait une trame de 8 octets
// S'il s'agit de données de mesures topo, on acquitte.
// En cas de succès de l'acquittement, on décode
// En cas de succès du décodage, l'appelant peut utiliser la visée
function TDistoX2Connexion.LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
var
  EWE: String;
  i: Integer;
  MyBuffer : TBuffer8Bytes;
  QTypeData, QOp: Byte;
  QX, QY, QZ, Dist: integer;
  P: float;
begin
  Result := false;
  if (self.SynSer.CanRead(FTimeOutInMilliseconds)) then
  begin
    try
      self.SynSer.RecvBuffer(@MyBuffer, 8);
      MyMesureVisee.DistoXSerialNumber := FDistoXSerialNumber;
      MyMesureVisee.TypeMesure := tmdxUNKNOWN;
      MyMesureVisee.Longueur := 0.00;
      MyMesureVisee.Azimut   := 0.00;
      MyMesureVisee.Pente    := 0.00;
      MyMesureVisee.IsMarked := false;
      MyMesureVisee.HexaData := '';
      EWE := '';
      for i := 0 to 7 do EWE += Format('%.2X', [MyBuffer[i]]);
      QTypeData := MyBuffer[0];
      QOp       := (QTypeData and $3F);
      // Ce sont des données ?
      if (QOp < $20) then
      begin
        if (Acknowledge(QTypeData)) then   // Indispensable juste après le test (QOp < $20), sinon, KO
        begin
          QX := MyBuffer[1] + (MyBuffer[2] shl 8);
          QY := MyBuffer[3] + (MyBuffer[4] shl 8);
          QZ := MyBuffer[5] + (MyBuffer[6] shl 8);
 
          if ((Foldtype <> QTypeData) and (FoldX    <> QX) and (FoldY    <> QY) and (FoldZ <> QZ)) then
          begin
            case QOp of
              1: // données topo
              begin
               // distances exprimées en mm si < 100 m, sinon en cm
               Dist := QX + ((QTypeData and $40) shr 10);     // OK
               //myMesureVisee.TypeMesure := op;
               myMesureVisee.TypeMesure := tmdxUNKNOWN;
               myMesureVisee.Longueur := Dist * 0.001; // TODO: Cas où Dist > 100 m
               myMesureVisee.Azimut   := radtodeg(QY * HEX_TO_RAD);                   // OK
               P  := radtodeg(QZ * HEX_TO_RAD);
               // if (Not InRange(P, -0.001, (90.001)) then P := P - 360.00;
               if (Not InRange(P, -0.001, 0.25 * 360.00 + 0.001)) then P := P - 360.00;
               myMesureVisee.Pente := P;
               myMesureVisee.HexaData := EWE;
               myMesureVisee.TimeStamp:= Now();
 
               Result := True;
              end;
              2, 3: ; // G et M, ne fonctionne pas
              4: ;
            else
              ;
            end;
            Foldtype := QTypeData;
            FoldX    := QX;
            FoldY    := QY;
            FoldZ    := QZ;
          end; // if ((Foldtype <> QTypeData) and (FoldX ...
        end; //  if (Acknowledge(qtype) = PROTO_OK)) then
      end; // if (QOp < $20) then
    except
    end;
  end;
end;
 
function TDistoX2Connexion.GetLastError(): integer;
begin
  result := self.SynSer.LastError;
end;
 
function TDistoX2Connexion.GetDescriptionDevice(): string;
begin
  Result := Format('Port: %s - Device: %d - Hardware: %d - Firmware: %d',
                   [FCommPort,
                    ExtractNumSerieFromDistoX(),
                    ExtractVersionHardwareFromDistoX(),
                    ExtractVersionFirmWareFromDistoX()
                   ]);
end;
 
procedure TDistoX2Connexion.DemanderUneMesure();
begin
  self.SynSer.SendByte(DISTOX_COMMAND_TRIG_DATA_SHOT);
end;
 
 
 
// Fonctions bas niveau de lecture/écriture
function TDistoX2Connexion.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
var
  MyBuffer: TBuffer8Bytes;
begin
  MyBuffer := MakeEmptyTBuffer8Bytes();
  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.SynSer.SendBuffer(@MyBuffer, 3);
  result := (0 = self.SynSer.LastError);
end;
 
function TDistoX2Connexion.ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
begin
  result := false;
  MyBuffer := MakeEmptyTBuffer8Bytes();
  if (SendReadCommandAtAddress(DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddress)) then
  begin
    self.SynSer.RecvBuffer(@MyBuffer, 8);
    Result := (0 = self.SynSer.LastError);
  end;
end;
 
// numéro de série du DistoX
function TDistoX2Connexion.ExtractNumSerieFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($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 TDistoX2Connexion.ExtractVersionFirmWareFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
  end;
  Result := FDistoXVersionFirmware;
end;
// version de hardware
function TDistoX2Connexion.ExtractVersionHardwareFromDistoX(): integer;
var
  MyBuffer: TBuffer8Bytes;
begin
  if (FDistoXVersionHardware = -1) then
  begin
    MyBuffer := MakeEmptyTBuffer8Bytes();
    if (ReadBuffer8BytesAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
  end;
  Result := FDistoXVersionHardware;
end;
end.

06/02/2019, 17h08
anapurna

Salut

Pour fermer ta communication je pense qu'il manque un

Code:

DeviceClose

.

Citation:

Envoyé par anapurna

salut

pour fermer ta communication

je pense qu'il manque un

Code:

DeviceClose

Pour fermer ma connexion, j'utilise la fonction Close() de TLazSerial, qui bascule la valeur de TLazSerial.Active à False

Le setter de TLazSerial.Active est:

Code:

1
2
3
4
5
6
7
8
9
10
 
procedure TLazSerial.SetActive(state: boolean);
begin
  if state=FActive then exit;
 
  if state then DeviceOpen
  else DeviceClose;
 
  FActive:=state;
end;

et le code de DeviceClose est:

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
 
procedure TLazSerial.DeviceClose;
begin
  // flush device
  if FSynSer.Handle<>INVALID_HANDLE_VALUE then
  begin
    FSynSer.Flush;
    FSynSer.CloseSocket;
 //   FSynSer.Purge;
  end;
 
  // stop capture thread
  if ReadThread<>nil then begin
    ReadThread.FreeOnTerminate:=false;
    ReadThread.MustDie:= true;
    while not ReadThread.Terminated do begin
      Application.ProcessMessages;
    end;
    ReadThread.Free;
    ReadThread:=nil;
  end;
 
  // close device
  if FSynSer.Handle<>INVALID_HANDLE_VALUE then begin
    FSynSer.Flush;
    FSynSer.CloseSocket;
  end;
end;

DeviceClose déclenche l'erreur -1 Fonction incorrecte je ne sais où

07/02/2019, 15h15
anapurna

Salut

L'erreur est lorsque tu cliques sur le bouton ou lorsque tu fermes la forme ?
07/02/2019, 15h20
JP CASSOU
Citation:

Envoyé par anapurna

salut

l'erreur est lorsque tu clique sur le bouton ou lorsque tu ferme la forme ?

Lors du click sur le bouton [Déconnecter]

Ce bouton appelle la fonction TDistoX2Connexion.Deconnecter(); dont voici le code
Code:

1 2 3 4 5 6 7 8 procedure TDistoX2Connexion.Deconnecter(); begin try self.Close; finally end; end;

TLazSerial: Un truc franchement chiant (Résolu)

Bjr,

Soit le type

Code:

1
2
 
TStatusEvent = procedure(Sender: TObject; Reason: THookSerialReason; const Value: string) of object;

et soit une de mes fonctions utilisateur incluses dans un TFrame

Code:

1
2
3
 
procedure ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);          
procedure ProcOnRXData(Sender: TObject);

J'accroche cette fonction utilisateur à mon objet instancié:

Code:

1
2
3
 
FConnexionDistoX.OnRxData := ProcOnRXData;         // OK
FConnexionDistoX.OnStatus := ProcHookStatus;         // <- erreur

et j'obtiens l'erreur suivante à la compilation:

Code:

1
2
 
cadredixtoxnew.pas(164,32) Error: Incompatible types: got "TCdrDistoX2New.ProcHookStatus(TObject;THookSerialReason;const AnsiString);" expected "<procedure variable type of procedure(TObject;THookSerialReason;const AnsiString) of object;Register>"

RESOLU: Il faut ajouter l'unité LazSynaSer

07/02/2019, 16h27
BeanzMaster

Salut pour ta dernière question

Code:

FConnexionDistoX.OnStatus := ProcHookStatus;

devrait être

Code:

FConnexionDistoX.OnStatus := @ProcHookStatus;

Avec FPC, il faut mettre le @

Cela devrait fonctionner normalement.

A+