VBA ET RS232 ENVOYER DES DONNÉES VIA PORT SÉRIE (EXEMPLE VERS ECRAN LCD)

program com;

uses dos,crt;

const nbport = 0;       {**********************************************}
                        {* nbport = 0     pour    COM1                *}
                        {* nbport = 1     pour    COM2                *}
                        {**********************************************}


procedure rs_init;
{**********************************************************************}
{* Initialise le port RS232C : 8 bits de donn‚es                      *}
{*                             2 bits Stop                            *}
{*                             Parit‚ Paire                           *}
{*                             Vitesse … 2400 Bauds                   *}
{*  Cette procedure doit ˆtre appel‚ une fois , avant de pouvoir      *}
{*  utiliser la liaison s‚rie                                         *}
{*  Entrée: AH = 0x00               				      *}			
{*                        DX = Numéro de l'interface série	      *}
{*                                0x00 = COM1                  	      *} 
{*                                0x01 = COM2			      *}
{*                        AL = Paramètres de configuration	      *}
{*                                Bits 0-1: longueur du mot	      *}	
{*                                        10 = 7 bits		      *}
{*                                        11 = 8 bits		      *}
{*                                Bit 2: nombre de bits de stop	      *}
{*                                        0 = 1 bit de stop	      *}
{*                                        1 = 2 bits de stop	      *}
{*                                Bit 3-4: contrôle de parité	      *}
{*                                        00 = aucun		      *}
{*                                        01 = impair		      *}
{*                                        11 = pair		      *}
{*                                Bit 5-7: vitesse de transmission    *}
{*                                        000 = 110 bauds	      *}
{*                                        001 = 150 bauds	      *}
{*                                        010 = 300 bauds	      *}
{*                                        011 = 600 bauds	      *}
{*                                        100 = 1200 bauds	      *}
{*                                        101 = 2400 bauds	      *}
{*                                        110 = 4800 bauds	      *}
{*                                        111 = 9600 bauds	      *}
{*								      *}
{**********************************************************************}

var
   regs : registers;
begin
     regs.ah:=0;
     regs.dx:=nbport;
     regs.al:=227;

     intr($14,regs);
{     writeln('R‚sultat initialisation ah=',regs.ah);}
end;

function rs_status:integer;
{*********************************************************************}
{* Cette fonction lit le statut du port s‚rie                        *}
{*********************************************************************}
var
   regs : registers;
begin
     regs.ah:=3;
     regs.dx:=nbport;
     intr($14,regs);
     rs_status:=regs.ah;
end;

function rs_read:integer;
{***********************************************************************}
{* Lecture au vol de la RS232C , Si aucun caractˆre n'a ‚t‚ recu la    *}
{* function renvoie -1                                                 *}
{***********************************************************************}
var
   regs : registers;

begin
     if (rs_status and 1)=1 then
        begin
             regs.ah:=2;
             regs.dx:=nbport;
             intr($14,regs);
if (regs.ah and 128)=128 then begin
   writeln('Il y a eu erreur en lecture, AH=:',regs.ah);
   end else rs_read:=regs.al;
      end else begin
                      rs_read:=-1;
                  end;
end;

function rs_lecture : integer;
{********************************************************************}
{* Cette function attend q'un caractŠre soit recu sur le port s‚rie *}
{********************************************************************}
var
   aux : integer;
begin
     repeat
           aux:=rs_read;
     until aux<>-1;
     rs_lecture:=aux;
end;

procedure rs_write(data : byte);
{*******************************************************************}
{* Cette proc‚dure permet d'emettre un caractŠre sur le port s‚rie *}
{*******************************************************************}
var
   regs : registers;

begin
     regs.ah:=1;
     regs.dx:=nbport;
     regs.al:=data;
     intr($14,regs);
     if (regs.ah and 128)=128 then writeln('Erreur transmition : ',regs.ah);
end;

procedure test_lecture;
{********************************************************************}
{* Cette procedure permet de tester la fiabilit‚ de la liaison      *}
{* PC - Robot , elle permet entre autre d'effectuer le r‚glage de   *}
{* Vitesse de la RS232 du robot VECTOR                              *}
{********************************************************************}
var
   err,i,aux,cnt : integer;

begin
     clrscr;
     rs_init;
     aux:=-1;
     err:=-1;
     cnt:=-1;
     repeat
           rs_init;
           i:=rs_lecture;
           if i<>aux+1 then err:=err+1;
           aux:=i;
           if i=255 then aux:=-1;
           inc(cnt);
     until keypressed or (cnt=1000);
     writeln;
     writeln('Il y a eu ',err,' erreurs sur 1000 ');
end;

procedure test_ecriture;
{*******************************************************************}
{* Permet de tester l'‚mission d'un caract‚re vers le robot VECTOR *}
{*******************************************************************}
var i,aux,j : integer;
    carac : char;

begin
     clrscr;
     repeat
     repeat until keypressed;
     carac:=readkey;
     rs_init;
     rs_write(ord(carac));
     write(carac);
     until ((carac='Q') or (carac='q'));
end;

var
   x:integer;
   a:string[1];
   y,c:integer;
   texte : string;
begin
     rs_init;

     texte = paramstr(1);

     for x:=1 to 80 do
     begin
     a:=copy(texte,x,1);
     rs_write(ordre(a));
     end;
     end;
end.