```delphi
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, CPort, CPortCtl, SyncObjs;
type
TForm1 = class(TForm)
btnConnect: TButton;
btnDisconnect: TButton;
btnRead: TButton;
btnWrite: TButton;
Memo1: TMemo;
edtTagData: TEdit;
Label1: TLabel;
StatusBar1: TStatusBar;
ComPort1: TComPort;
ComComboBox1: TComComboBox;
ComboBoxBaudRate: TComboBox;
Label2: TLabel;
Label3: TLabel;
procedure btnConnectClick(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure btnReadClick(Sender: TObject);
procedure btnWriteClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ComPort1RxChar(Sender: TObject; Count: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Déclarations privées }
FConnected: Boolean;
FResponseBuffer: string;
FCriticalSection: TRTLCriticalSection;
procedure Log(const Msg: string);
procedure UpdateUI;
function SendCommand(const Cmd: string; WaitForResponse: Boolean = True;
Timeout: Integer = 1000): string;
function ParseResponse(const Response: string; out TagData: string): Boolean;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
// Commandes RFID spécifiques pour Nordic ID Sampo S3 (à adapter selon la
documentation)
CMD_READ_TAG = '#READ';
CMD_WRITE_TAG = '#WRITE';
RESPONSE_OK = 'OK';
RESPONSE_ERROR = 'ERROR';
procedure [Link](Sender: TObject);
var
BaudRate: Integer;
begin
if not FConnected then
begin
try
// Configurer le port COM
[Link] := [Link];
// Mapper le baud rate correctement
BaudRate := StrToIntDef([Link], 9600);
case BaudRate of
300: [Link] := br300;
1200: [Link] := br1200;
2400: [Link] := br2400;
4800: [Link] := br4800;
9600: [Link] := br9600;
19200: [Link] := br19200;
38400: [Link] := br38400;
else
raise [Link]('Baud rate non supporté: ' +
[Link]);
end;
[Link];
FConnected := True;
Log('Connecté au port ' + [Link] + ' à ' + IntToStr(BaudRate) + '
bauds');
UpdateUI;
except
on E: Exception do
begin
Log('Erreur de connexion: ' + [Link]);
FConnected := False;
UpdateUI;
end;
end;
end;
end;
procedure [Link](Sender: TObject);
begin
if FConnected then
begin
[Link];
FConnected := False;
Log('Déconnecté du port COM');
UpdateUI;
end;
end;
procedure [Link](Sender: TObject);
var
Response: string;
TagData: string;
begin
if FConnected then
begin
try
Log('Envoi de la commande de lecture...');
Response := SendCommand(CMD_READ_TAG);
if ParseResponse(Response, TagData) then
begin
[Link] := TagData;
Log('Tag lu: ' + [Link]);
end
else if Pos(RESPONSE_ERROR, Response) > 0 then
begin
Log('Erreur de lecture: ' + Response);
end
else
begin
Log('Réponse inattendue: ' + Response);
end;
except
on E: Exception do
Log('Erreur lors de la lecture: ' + [Link]);
end;
end
else
begin
Log('Veuillez d''abord vous connecter au lecteur');
end;
end;
procedure [Link](Sender: TObject);
var
Response: string;
begin
if FConnected then
begin
if Trim([Link]) <> '' then
begin
try
Log('Envoi de la commande d''écriture...');
Response := SendCommand(CMD_WRITE_TAG + '|' + [Link]);
if Pos(RESPONSE_OK, Response) > 0 then
begin
Log('Écriture réussie sur le tag');
end
else
begin
Log('Erreur d''écriture: ' + Response);
end;
except
on E: Exception do
Log('Erreur lors de l''écriture: ' + [Link]);
end;
end
else
begin
Log('Veuillez entrer des données à écrire');
end;
end
else
begin
Log('Veuillez d''abord vous connecter au lecteur');
end;
end;
procedure [Link](Sender: TObject);
begin
FConnected := False;
InitializeCriticalSection(FCriticalSection);
// Initialiser les paramètres COM
[Link];
// Peupler le ComboBoxBaudRate dynamiquement
[Link]('300');
[Link]('1200');
[Link]('2400');
[Link]('4800');
[Link]('9600');
[Link]('19200');
[Link]('38400');
[Link] := [Link]('9600');
UpdateUI;
Log('Prêt. Veuillez sélectionner le port COM et vous connecter');
end;
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
Str: string;
begin
// Recevoir les données du port COM de manière thread-safe
[Link](Str, Count);
EnterCriticalSection(FCriticalSection);
try
FResponseBuffer := FResponseBuffer + Str;
finally
LeaveCriticalSection(FCriticalSection);
end;
end;
procedure [Link](Sender: TObject; var Action: TCloseAction);
begin
if FConnected then
[Link];
DeleteCriticalSection(FCriticalSection);
end;
procedure [Link](const Msg: string);
begin
[Link](FormatDateTime('hh:nn:ss', Now) + ' - ' + Msg);
[Link](EM_SCROLLCARET, 0, 0);
end;
procedure [Link];
begin
[Link] := not FConnected;
[Link] := FConnected;
[Link] := FConnected;
[Link] := FConnected;
[Link] := not FConnected;
[Link] := not FConnected;
if FConnected then
[Link][0].Text := 'Status: Connecté à ' + [Link]
else
[Link][0].Text := 'Status: Déconnecté';
end;
function [Link](const Cmd: string; WaitForResponse: Boolean; Timeout:
Integer): string;
var
StartTime: Cardinal;
begin
EnterCriticalSection(FCriticalSection);
try
FResponseBuffer := '';
finally
LeaveCriticalSection(FCriticalSection);
end;
try
// Envoyer la commande (ajouter un retour chariot si nécessaire)
[Link](Cmd + #13#10);
Log('Commande envoyée: ' + Cmd);
except
on E: Exception do
begin
Log('Erreur lors de l''envoi de la commande: ' + [Link]);
Exit('');
end;
end;
if WaitForResponse then
begin
// Attendre la réponse avec timeout
StartTime := GetTickCount;
while True do
begin
EnterCriticalSection(FCriticalSection);
try
if FResponseBuffer <> '' then
Break;
finally
LeaveCriticalSection(FCriticalSection);
end;
if GetTickCount - StartTime >= Cardinal(Timeout) then
begin
Log('Timeout: Aucune réponse reçue');
Exit('');
end;
[Link];
Sleep(10);
end;
EnterCriticalSection(FCriticalSection);
try
Result := Trim(FResponseBuffer);
finally
LeaveCriticalSection(FCriticalSection);
end;
end
else
begin
Result := '';
end;
end;
function [Link](const Response: string; out TagData: string):
Boolean;
begin
Result := False;
TagData := '';
if Pos(RESPONSE_OK, Response) = 1 then
begin
if Pos('|', Response) > 0 then
begin
TagData := Copy(Response, Pos('|', Response) + 1, Length(Response));
Result := True;
end;
end;
end;
end.
```
