Communication série RS232 en Delphi (2..3..4..5)


L'unité qui suit ( CommUnit.Pas) permet de piloter les ports série en mode synchrone à l'aide d'instructions simples comme celles-ci :

Initialisation du port :
INITCOM ('COM1',9600,NOPARITY,8,ONESTOPBIT);
Ici toutes les valeurs prévues dans L'API de WINDOWS sont autorisées.

Lecture des données sur le port initialisé :
Read_com_data  (timeout en ms);
Si la taille du message reçu est inférieure ou égale  à 2048 octets (paramétrables dans le code), le message est lu dans la variable globale buffread, sinon  il est lu dans la liste chaînée de tampons de 2048 octets (même paramètre) initialisée à PremBufCom. Ce procédé est automatique. Pour savoir où ont été récupérées les données il suffit de lire le total d'octets lus dans tot_nbread. Elles sont dans buffread si tot_nbread est inférieur à 2048 et dans la liste PremBufCom sinon.
 

Ecriture des données sur le port initialisé :
Write_com_data  (nombre d'octets);
Si la taille du message émis est inférieure ou égale  à 2048 octets (paramétrables dans le code), le message est émis à partir  de la variable globale buffwrite, sinon  il est émis à partir de la zone mémoire pointée par PWriteCom. C'est alors au programmeur de préparer les données à écrire dans le bon buffer sachant que la procédure se débrouille pour les retrouver.

Ecriture d'une chaîne ASCII sur le port initialisé :
ms := 'Hello';
Write_com (ms);
La chaîne est sensée faire 2048 octets maximum ( toujours le même paramètre).

Libération de la ressource :
RESETCOM ('COM1');
Indispensable pour qu'une autre application puisse à son tour l'utiliser.
 

Exemple de transmission d'un fichier de plusieurs centaines de kilo-octets en cinq instructions .
Le fichier est dans C:\Mes Documents et s'appelle MonCourrierATransmettre.txt et doit être transmis à 115200 bauds par le COM2 sur 7 bits avec parité paire et 2 bits de stop:
 

if not INITCOM ('COM2',115200,EVENPARITY,7,TWOSTOPBITS)
    then Showmessage ('COM non disponible')
 else
     begin   
         path := 'C:\Mes Documents\MonCourrierATransmettre.txt';
         Charge_fi_memoire;
         Xmit_fichier_close;
         RESETCOM ('COM2');
     end;
Le code est normalement suffisamment commenté mais je peux fournir toute précision demandée (cf Messagerie.) Il faut noter que le mode asynchrone n'est pas supporté par Delphi quelle qu'en soit la  version.En effet la fonction ReadFile en Delphi ne supporte pas le pointeur lpOverlapped. Pour une application asynchrone le code doit être écrit en C bien que l'on puisse sous Delphi appliquer la technique des threads pour "simuler" un mode asynchrone.
 
(******************************************************************************
                     UNITE DE GESTION DES COM INTERFACE SERIE RS232
                       RS232 SERIAL COMMUNICATIONS HANDLING
                          Copyright JP. Trolet 1998
*******************************************************************************)
unit CommUnit;

{$T-}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;



const Pcom : array [0..3] of PChar = ('COM1','COM2','COM3','COM4');
      Com_bufsize = 2048;                        { taille du tampon élémentaire}
                                                 { size of basic buffer}

      mess_err_ecr = 'Ecriture incomplète';


type
  PBufCom = ^TBufCom;           {pointeur sur structure fournissant des zones..}
  TbufCom = record                       {..dynamiques pour stocker les données}
          Pt : pointer;                                {..lues en liste chaînée}
          suiv : PBufCom;                       {pointeur sur le buffer suivant}
          end;

  TUserComPar = record
         VITESSE : DWORD;         {les 4 paramètres usuels}
         PARITE,
         NBITS,
         BITSTOP : BYTE;
         end;

var  tab_hcom : array [0..3] of THandle;                      { handle des COM }
     tab_comDCB : array [0..3] of TDCB;          {table des Data Control Blocks}
     idx_com  : BYTE;                           { index du ou des COMS utilisés}
     h1com    : THandle;               
     UserComPar : array [0..3] of TUserComPar;   {les 4 paramètres usuels}

     {tampons élémentaires}
     buffread,buffwrite : array [1..Com_BufSize] of byte;

     Pnbread,PnbWrit : DWORD;       {nombre de données lues ou écrites à chaque
                                                       { opération élémentaire }
     SCommTimeOuts : TCommTimeOuts;                     {paramètres de Time Out}
     Tot_nbread,Tot_nbwrit : DWORD;          {totaux des données lues ou écrites}

     {pointeurs sur les zones tampon où sont stockées les données fragmentées en
     lecture}
     Prembufcom,NouvBufCom,DernBufCom,CourBufCom : PBufCom;

     PWriteCom : ^BYTE;                          { pointeur de la zone à écrire}


     path : string;                      { chemin }
     fichier: file;
     siz : dword;                       { taille du fichier }



function index_com (Plib_com : PChar) : shortint;
function InitCom (Plib_com : Pchar; vit : DWORD; par,nbits,btstp : BYTE) : boolean;

                  { Plib_com = 'COM1' 'COM2' etc....
                    vit = 110...256000
                    par = NOPARITY,ODDPARITY,EVENPARITY,MARKPARITY
                    nbits = 4..8
                    btstp = ONESTOPBIT,ONE5STOPBITS,TWOSTOPBITS}

procedure Reset_all_coms;
procedure ResetCom (Plib_com : PChar);
procedure ResetReadMemory;
procedure Read_Com_Data  (IntervalTimeOut : DWORD);
function  Write_Com_Data ( nbw : DWORD) : DWORD;
function  Write_Com (s : string): boolean;
procedure Charge_fi_memoire;
procedure Xmit_fichier_close;



implementation

function index_com (Plib_com : PChar) : shortint;
var i : shortint;
begin
     { cherche index du Comm }
 i := -1;
 repeat
 Inc (i);
 until StrComp (Plib_com ,Pcom [i]) = 0;
 result := i;
end;



{ INITIALISATION du COM }
function InitCom (Plib_com : Pchar; vit : DWORD; par,nbits,btstp : BYTE): boolean;
begin
 idx_com := index_com (Plib_com);

 tab_hcom [idx_com] := CreateFile (Plib_com,GENERIC_READ OR GENERIC_WRITE,0,nil,
                                  OPEN_EXISTING,0,0);
 if tab_hcom [idx_com] <> INVALID_HANDLE_VALUE then
 begin
 { handle valide : on lit le status du COM }
  if NOT GetCommState (tab_hcom [idx_com],tab_comDCB [idx_com])
      then ShowMessage ('Erreur dans GetCommState')
   else
   { status OK }
   with tab_comDCB [idx_com] do     {compléter le status avec les paramètres
                                                                        usuels}
   begin
    BaudRate := vit;
    parity := par;
    if Parity <> NOPARITY then flags := flags OR $4000; {autoriser le contrôle
                                                                     de parité}
    ByteSize := nbits;
    StopBits := btstp;
   end;
  if NOT SetCommState (tab_hcom [idx_com],tab_comDCB [idx_com])
   then ShowMessage ('Erreur dans SetCommState')
   else result := true;
 end

 else result := false;
 {else Showmessage ('Handle invalide pour l''ouverture');}
end;

{Free all com handles to make them available for other users}
procedure Reset_all_coms;
var j : integer;
    svidx : byte;
begin
  svidx := idx_com;          // save index;
  for j := 0 to 3 do ResetCom (PCom [j]);
  idx_com := svidx;
end;

{ Libération du COM pour un autre utilisateur }
procedure ResetCom (Plib_com : PChar);
begin
 idx_com := index_com (Plib_com);
 if tab_hcom [idx_com] <> INVALID_HANDLE_VALUE
  then CloseHandle (tab_hcom [idx_com])                        { handle libéré}
{  else Showmessage ('Handle invalide en fermeture ');}
end;


{Libération de la mémoire tampon utilisée en lecture}
procedure ResetReadMemory;
begin
 if PremBufCom <> nil then
 begin
  CourBufCom := PremBufCom;
  while CourBufCom <> nil do
  begin
   FreeMem (CourBufCom.Pt,Com_BufSize);
   CourBufCom := CourBufCom.suiv;
  end;
 PremBufCom := nil;
 end;
end;


{Lecture des données sur le COM }
procedure Read_Com_Data ( IntervalTimeOut : DWORD);
var Rres,stim : BOOL;                { résultats des opérations }
    vit : double;
    tmptimeout : DWORD;
    i : integer;

begin
 Tot_nbread := 0;
 PremBufCom := nil;
 for i := 1 to  Com_BufSize do BuffRead [i] := 0;


  with ScommTimeouts do
  begin
   ReadIntervalTimeout:= IntervalTimeOut; { X ms entre chaque caractère}
                                          {représente aussi le délai pour
                                          sortir de la transmission si le
                                          paquet est contenu dans le tampon
                                          élémentaire BUFFREAD }
   ReadTotalTimeoutMultiplier := 0;
   ReadTotalTimeoutConstant:= 0;
  end;

 { stim = status du Time Out }
 stim := SetCommTimeOuts (tab_hcom [idx_com],SCommTimeOuts);

 {lecture dans le tampon élémentaire}
 Rres := ReadFile (tab_hcom [idx_com],buffread,Com_BufSize,Pnbread,nil );

 if  Rres AND (Pnbread = Com_BufSize) then     { modif du régime de time-out
                                                pour éviter le blocage sur la
                                                limite de tampon (Ne pas
                                                attendre de caractère suivant
                                                si la limite de tampon contient
                                                le dernier caractère émis).

                                                 Ici buffread
                                                est saturé : on entame la liste
                                                chaînée }
 begin
  ScommTimeOuts.ReadIntervalTimeout := 0;
  vit := tab_comDCB [idx_com].BaudRate;
  tmptimeout := round (120000 / vit);
  if tmptimeout > 25 then tmptimeout := 25;
  ScommTimeOuts.ReadTotalTimeoutMultiplier:= tmptimeout;
  stim := SetCommTimeOuts (tab_hcom [idx_com],SCommTimeOuts);
 end;


 While Rres AND (Pnbread = Com_BufSize) do    { tant que le tampon est saturé
                                               refaire une lecture}
 begin
   Tot_nbread := Tot_nbread + Pnbread;
   new (NouvBufCom);
   GetMem (NouvBufCom.Pt,Com_BufSize);
   Move (BuffRead,NouvBufCom.Pt^,Pnbread);    { sauve le tampon}

   if PremBufCom = nil then PremBufCom := NouvBufCom
   else dernBufCom.suiv := NouvBufCom;
   DernBufCom := NouvBufCom;
   DernBufCom.suiv := nil;

   {lecture suivante}
   Rres := ReadFile (tab_hcom [idx_com],buffread,Com_BufSize,Pnbread,nil );
 end;
 Tot_nbread := Tot_nbread + Pnbread;                     { Nombre d'octets lus }
end;



{Ecriture de nbw octets à partir de l'adresse PWriteCom si nbw > taille du
tampon sinon directement de celui-ci : buffwrite}
function Write_Com_Data ( nbw : DWORD) : DWORD;
var Rres : BOOL;
    PBufWrite : ^BYTE;   {pointeur de lecture temporaire }
begin
 if nbw <= Com_BufSize then           { écriture simple du tampon élémentaire }
 begin
  Rres := WriteFile (tab_hcom [idx_com],buffwrite,nbw,Pnbwrit,nil );
  if NOT (Rres AND (nbw = Pnbwrit)) then Showmessage (mess_err_ecr);
  Tot_nbwrit := Pnbwrit;
 end
 else
 begin
  Tot_nbwrit := 0;
  PBufWrite := pointer(PwriteCom);
  while (nbw - Tot_nbwrit) > Com_BufSize do   {tant que tamp. élémentaire plein}
  begin
    Move (PBufWrite^,BuffWrite,Com_BufSize);
    { Ecriture du tampon }
    Rres := WriteFile (tab_hcom [idx_com],buffwrite,Com_BufSize,Pnbwrit,nil);
    if NOT (Rres AND (Pnbwrit = Com_Bufsize)) then Showmessage (mess_err_ecr);
    if Rres then
    begin
     Inc (PBufWrite,Com_BufSize);                  { on pointe le bloc suivant }
     Tot_nbwrit := Tot_nbwrit + Com_BufSize;
    end;
  end;  { while (nbw ...}

  { écrire le reste }
  Move (PBufWrite^,BuffWrite,nbw - Tot_nbwrit);
  Rres := WriteFile (tab_hcom [idx_com],buffwrite,nbw - Tot_nbwrit,Pnbwrit,
                                                                      nil );
  if NOT (Rres AND (nbw-Tot_nbwrit = Pnbwrit)) then
                                        Showmessage (mess_err_ecr);
  if Rres then Tot_nbwrit := Tot_nbwrit + Pnbwrit;  {    total d'octets écrits}

 end;

 result := Tot_nbwrit;
end;


{ Ecriture d'une chaîne sur le COM }
function Write_Com (s : string) : boolean;
var Rres : Bool;
    j,l : word;
begin
 l := length (s);
 if l < Com_BufSize then for j := 1 to l do buffwrite [j] := ord (s[j]);
 result := (Write_Com_Data (l) = l);
end;


procedure Charge_fi_memoire;
begin
      AssignFile (fichier,path);
      reset (fichier,1);
      siz := filesize (fichier);
      if siz <= Com_Bufsize then blockread (fichier,buffwrite,siz)
      else
      begin
       GetMem (PWriteCom,siz);
       blockread (fichier,PWriteCom^,siz);
      end;
end;


procedure Xmit_fichier_close;
begin
    siz := filesize (fichier);
    Write_Com_Data (siz);
    closeFile (fichier);
end;

end.