[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]

{
> I've been wondering this for quite awhile now - Is there a way to access
> the communication ports in OS/2 using Borland Pascal. I'd like to create
> a BBS app?

Here's some code that I've put toegether that should get you in the right
direction (it's a dumb terminal program for OS/2):
}
program dt2;

uses
  dosprocs, os2subs;

Const
  ExtKeyChar : Char = #0;

  Function KeyPressed : Boolean;
  Var
    KeyInfo : TKbdKeyInfo;
  Begin
    KbdPeek(KeyInfo,0);
    KeyPressed:= (ExtKeyChar <> #0) or ((KeyInfo.fbStatus And $40) <> 0);
  End;

  Function ReadKey : Char;
  Var
    KeyInfo : TKbdKeyInfo;
  Begin
    If ExtKeyChar <> #0 then
      Begin
        ReadKey:= ExtKeyChar;
        ExtKeyChar:= #0
      End
    else
      Begin
        KbdCharIn(KeyInfo,0,0);
        If KeyInfo.chChar = #0 then
          ExtKeyChar:= KeyInfo.chScan;
        ReadKey:= KeyInfo.chChar;
      End;
  End;

type
  mdmlinerec = record
    databits : byte;
    parity   : byte;
    stopbits : byte;
  end;
  mdmctlrec = record
    onmask   : byte;
    offmask  : byte;
  end;
  mdmdcbrec = record
    wtime    : word;
    rtime    : word;
    flags1   : byte;
    flags2   : byte;
    flags3   : byte;
    errchar  : byte;
    brkchar  : byte;
    xonchar  : byte;
    xoffchar : byte;
  end;
  siodterec = record
    dte      : longint;
    fraction : byte;
  end;
  bufstatrec = record
    bufused  : word;
    bufsize  : word;
  end;
  dtestatrec = record
    dterate  : longint;
    dtefract : byte;
    mindte   : longint;
    minfract : byte;
    maxdte   : longint;
    maxfract : byte;
  end;

var
  comh : word;
  mdmline : mdmlinerec; mdmctl : mdmctlrec; mdmdcb : mdmdcbrec;
  siodte : siodterec; bufstat : bufstatrec; dtestat : dtestatrec;

function si(s : string) : longint;
var
  i : longint; c : word;
begin
  si := 0;
  val(s, i, c);
  if c = 0 then
    si := i;
end;

procedure sendport(s : string);
var
  i, written : word;
begin
  for i := 1 to length(s) do
    doswrite(comh, s[i], 1, written);
end;

procedure funcall(s : string; w : word);
begin  { shows what DLL call generates error if any }
  if w > 0 then begin
    writeln('Error ['+s+']; result code: ', w);
    halt;
  end;
end;

function carrier : boolean;
var
  mdminsig : byte;
begin
  funcall('Check DCD', dosdevioctl(@mdminsig, nil, 103, 1, comh));
  if (mdminsig and 128) = 128 then
    carrier := true
  else
    carrier := false;
end;

function getdte : longint;
var
  baud : word;
begin
  funcall('SIO.SYS Grab DTE', dosdevioctl(@dtestat, nil, 99, 1, comh));
  { funcall('COM.SYS Get DTE', dosdevioctl(@baud, nil, $61, 1, comh)); }
  getdte := dtestat.dterate;
end;

function rcvbufused : word;
begin
  funcall('Check Rcv Buff', dosdevioctl(@bufstat, nil, 104, 1, comh));
  rcvbufused := bufstat.bufused;
end;

procedure initcomm(cport : byte; dte : longint);
var
   action, comerr : word;
  comstr : string[6];
  portz : array[1..5] of char;
begin
  { This routine is based off of OS2COMM.C's INITCOMM function done in
  1988 by Jim Gilliland }
  comerr := 0;
  comstr := 'COM'+chr(48+cport)+#0;
  move(comstr[1], portz, 5);
  funcall('Open Port', dosopen(@portz, comh, action, 0, 0, 1, 66, 0));
  { note: 66 means "deny none" access to com port }
  writeln('Initial DTE [', getdte, ']');
  if dte > 57600 then begin { for speeds > 57600, use SIO function 43h }
    siodte.dte := dte;  { I hope you are using SIO }
    siodte.fraction := 0;
    funcall('Set SIO DTE', dosdevioctl(nil, @siodte, 67, 1, comh));
  end else
    funcall('Set DTE Rate', dosdevioctl(nil, @dte, 65, 1, comh));
  mdmline.databits := 8;
  mdmline.parity := 0; { N-parity }
  mdmline.stopbits := 0; { 1-stop bit }
  funcall('Set N81', dosdevioctl(nil, @mdmline, 66, 1, comh));
  mdmctl.onmask := 3; { DTR/RTS on }
  mdmctl.offmask := 255; { nothing off }
  funcall('Set DTR/RTS', dosdevioctl(@comerr, @mdmctl, 70, 1, comh));
  mdmdcb.wtime := 10;
  mdmdcb.rtime := 10;
  mdmdcb.flags1 := 1;
  mdmdcb.flags2 := 64;
  mdmdcb.flags3 := 4;
  mdmdcb.errchar := 0;
  mdmdcb.brkchar := 0;
  mdmdcb.xonchar := 17;
  mdmdcb.xoffchar := 19;
  funcall('Set DCB', dosdevioctl(nil, @mdmdcb, 83, 1, comh));
end;

procedure dumbterm;
var
  i, w : word;
  ch : char;
  incom : array[1..512] of char;
begin
  writeln;
  writeln('[VERY DUMB TERMINAL/2 0.1] **** USE CTRL-Z TO EXIT THE PROGRAM ****');
  sendport('ATZ'+#13); { example initialization string }
  repeat
    if keypressed then begin
      ch := readkey;
      doswrite(comh, ch, 1, w);
    end else begin
      if dosread(comh, incom, 512, w) = 0 then begin
        for i := 1 to w do
          write(incom[i]);
      end;
    end;
  until(ch = #26);
end;

var
  dte : longint;
  cport : byte;
  version : word;
begin
  if paramcount < 2 then begin
    writeln(' Syntax: DT port dte');
    writeln('Example: DT 3 115200');
    halt;
  end;
  cport := si(paramstr(1));
  dte := si(paramstr(2));
  dosgetversion(version);
  writeln('Program written by B.J. Guillot [BGFAX author] Nov 1994');
  writeln('Fido 1:106/400   Internet email: bjg90783@jetson.uh.edu');
  writeln('Program written for German 16-bit OS/2 patch for BP 7.0');
  writeln;
  writeln('Port [', cport, ']  DTE [', dte, ']');
  initcomm(cport, dte); { initialies the port and grabs com handle }
  dumbterm;
  writeln('Closing port...');
  writeln(dosclose(comh));
end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]