Soyez le premier à donner votre avis sur cette source.
Snippet vu 17 621 fois - Téléchargée 33 fois
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.
Commentaire
@+ Neria
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.