Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBBS/ECO_232.PAS

Pascal/Delphi Source File | 1992-06-08 | 5.8 KB | 213 lines

{
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
}

{$R-,S-}
{
     byte: 7   6   5    4    3       2      1    0
           ─────────    ──────    ───────   ──────
           baud rate    parity    stopbit   length


           tabel  i:                │       tabel  ii:
   baud rate:   bit: 7  6  5        │  parity:   bit   4   3
   ─────────────────────────────────┼─────────────────────────────
                                    │
         110         0  0  0        │    none          0   0
         150         0  0  1        │
         300         0  1  0        │     odd          0   1
         600         0  1  1        │
        1200         1  0  0        │    even          1   1
        2400         1  0  1        │
        4800         1  1  0        │
        9600         1  1  1        │


           tabel  iii:              │       tabel  iv:
   stop bits:      bit: 2           │  length:   bit:  1   0
   ─────────────────────────────────┼─────────────────────────────
                                    │
       1  bit           0           │  7 bits          1   0
                                    │
       2 bits           1           │  8 bits          1   1

   convert this binary code into a hexadecimal code and use it as in the
   following example:


uses
  eco_232

  ;


var
  com1: text;


begin
   assignaux(com1,0,$83);  /this ($83) means com1, 1200 baud, no parity\
   rewrite(com1);          /1 stop bit and 8 data bits                 \
   writeln(com1,'devicedriver by persistent thought dynamics!')
   close(com1);
end.
}



unit eco_232;

interface
uses
  dos

  ;


  procedure assignaux(var f: text; port,params: word);



implementation


type
  auxrec = record
    port,params: word;
    unused: array[1..12] of byte;
  end;


  procedure auxinit(port,param: word);
  inline(
    $58/         {pop ax    ;pop parameters          }
    $5a/         {pop dx    ;pop port number         }
    $b4/$00/     {mov ah,0  ;code for initialise     }
    $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/     {mov ah,1  ;code for output         }
    $cd/$14      {int 14h   ;call bios               }
  );


  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: integer;
  begin
    with f,auxrec(userdata) do begin
      p := 0;
      while auxinready(port) and (p<bufsize) do begin
        bufptr^[p] := auxinchar(port); inc(p)
      end;
      bufpos := 0; bufend := p
    end;
    auxinput := 0
  end;




  function auxoutput(var f: textrec): integer;
  var p: integer;
  begin
    with f,auxrec(userdata) do begin
      p := 0;
      while p<bufpos do begin
        auxoutchar(port,bufptr^[p]);
        inc(p)
      end;
      bufpos := 0
    end;
    auxoutput := 0
  end;



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


  function auxopen(var f: textrec): integer;
  begin
    with f,auxrec(userdata) do begin
      auxinit(port,params);
      if mode = fminput then begin
        inoutfunc := @auxinput; flushfunc := @auxignore
      end else begin
        mode := fmoutput; inoutfunc := @auxoutput;
        flushfunc := @auxoutput
      end;
      closefunc := @auxignore
    end;
    auxopen := 0;
  end;
{$F-}




  procedure assignaux;
  begin
    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;



end. { unit }