NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/comp/lang/pascal/7552

Internet Message Format | 1992-12-17 | 5.8 KB

Path: sparky!uunet!usc!sdd.hp.com!zaphod.mps.ohio-state.edu!malgudi.oar.net!news.ans.net!cmcl2!adm!news
From: [e-mail]
Newsgroups: comp.lang.pascal
Subject: Re: Need serial port unit.
Message-ID: <[e-mail]>
Date: 17 Dec 92 18:22:27 GMT
Sender: [e-mail]
Lines: 212

>
>Anyone got a decent unit for changing/setting the COM port parameters?
>
>Thanks in advance!
>--
>John DeRose                [e-mail]
>Computer Science Undergrad
>
The following code is a text device driver that allows you to assign a COM port to a "text" type file and do i/o with the regular read/write statements, etc.  The only visible procedure is AssignAux which sets the parameters of the serial port.

This unit, based on an example in the TP4.0 manual, was used for driving a serial plotter and I have embedded in it various prompts and visual confirmation that data *is* going out of the port.

--------------------------------cut here----------------------------
unit auxinout;
interface
uses dos, crt, util;

type  __paritytype = (odd, even, none);

procedure assignaux(var F: text;
                    portnumber, baudrate, stopbits, databits:  word;
                    parity : __paritytype );
implementation
{$R-,S-}
type
  auxrec = record
             port,params: word;
             unused: array[1..12] of byte;
           end;

var
  port, params: word;
  xcol,ycol : byte;

function auxinit(port,params: word): byte;
inline(
  $58/              { POP AX       ; pop parameters }
  $5A/              { POP DX       ; pop port number }
  $B4/$00/          { MOV AH,0     ; code for initialize }
  $CD/$14);         { INT 14H      ; Call BIOS }

function auxinchar(port: word): char;
inline(
  $5A/              { POP DX      ; pop port number }
  $B4/$02/          { MOV AH,2    ; code for input }
  $CD/$14);         { INT 14H     ; call BIOS }

procedure auxoutchar(port: word; ch: char);
inline(
  $58/              {      POP AX      ; pop character }
  $5A/              {      POP DX      ; pop port number }
  $B4/$01/          { LOOP MOV AH,1    ; code for output }
  $CD/$14/          {      INT 14H     ; call BIOS }
  $80/$E4/$80/      {      AND AH,$80  ; check time-out }
  $75/$F7);         {      JNZ LOOP    ; try again }

function auxinready(port: word): boolean;
inline(
  $5A/              { POP DX      ; pop port number }
  $B4/$03/          { MOV AH,3    ; code for status }
  $CD/$14/          { INT 14H     ; call BIOS }
  $88/$E0/          { MOV AL,AH   ; get line status in AH }
  $24/$01);         { AND AL,1    ; isolate Data Ready bit }

{$F+}

function auxinput(var F: textrec): integer;
var
  p: word;
begin
  with f,auxrec(userdata) do begin
    p := 0;
    repeat until auxinready(port);
    while auxinready(port) and (p<bufsize) do begin
      bufptr^[p] := auxinchar(port);
      inc(p)
    end;
    bufpos := 0;
    bufend := p
  end;
  auxinput := 0
end; { auxinput }

function auxoutput(var f: textrec): integer;
var
  p: word;
begin
  with f,auxrec(userdata) do begin
    p := 0;
    gotoxy(27, 20);
    clreol;
    while p<bufpos do begin
      auxoutchar(port,bufptr^[p]);
      write(#9);
      inc(p)
    end;
    bufpos := 0
  end;
  auxoutput := 0
end; { auxoutput }

function auxclose(var f : textrec) : integer;
begin
  gotoxy(1,20);
  clreol;
  gotoxy(xcol, ycol);

  auxclose := 0
end; { auxclose }

function auxignore(var f: textrec ): integer;
begin
  auxignore := 0
end; { auxignore }

function auxopen(var f: textrec): integer;
begin
  with f,auxrec(userdata) do begin
    if mode=fmInput then begin
      inoutfunc := @auxinput;
      flushfunc := @auxignore
    end
    else begin
      mode := fmOutput;
      inoutfunc := @auxoutput;
      flushfunc := @auxoutput
    end;
    closefunc := @auxclose
  end;
  xcol := wherex;
  ycol := wherey;
  gotoxy(10,20);
  clreol;
  write('plotting to COM', port+1,':');
  gotoxy(xcol, ycol);

  auxopen := 0
end; { auxopen }

{$F-}

procedure assignaux;
var comstr : string;
    temp   : string;
    ch     : char;
    ready  : boolean;
    regs   : registers;
    dsr    : word;
begin

  case baudrate of
     110:  baudrate := 0;
     150:  baudrate := 1;
     300:  baudrate := 2;
     600:  baudrate := 3;
    1200:  baudrate := 4;
    2400:  baudrate := 5;
    4800:  baudrate := 6;
    else baudrate := 7;  { default to 9600 }
  end;  { case }

  if stopbits = 2 then stopbits := 1
  else stopbits := 0;    { default to 1 stop bit }

  if databits = 7 then databits := 2
  else databits := 3;    { default to 8 data bits }

  params := (baudrate shl 5) + (stopbits shl 2) + databits;
  port := portnumber - 1;

  case parity of
     odd:  params := params + 8;
    even:  params := params + 24;
    else;  { default to no parity }
  end; { case }

    dsr := (auxinit(port,params) shr 4) and 3;
    ready := dsr = 3;

  while not Ready do begin
    inc(textattr, blink);
    center_write('Plotter not accepting data.', wherey+1);
    center_write('Press <space> to resume when setup corrected, <Esc> to quit.', wherey+1);
    buzz;
    dec(textattr, blink);
    repeat
      ch := readkey
    until ch in [' ', #27];
    if ch = #27 then abort;
    dsr := (auxinit(port,params) shr 4) and 3;
    ready := dsr = 3;
    gotoxy(1, wherey-2);
  end;
  gotoxy(1, wherey+1); clreol;
  gotoxy(1, wherey+1); clreol;


  with textrec(f) do begin
    handle := $FFFF;
    mode := fmClosed;
    bufsize := sizeof(buffer);
    bufptr := @buffer;
    openfunc := @auxopen;
    auxrec(userdata).port := port;
    auxrec(userdata).params := params;
    name[0] := #0
  end
end; { assignaux }

begin
end. { unit AuxInOut }
------------------------------cut here-------------------------------*****************************************************************[e-mail] A. Evans,School of Marine Science, Virginia Institute of Marine ScienceCollege of William and MaryGloucester Point, Virginia, USA*****************************************************************