Unit IOPorts;

{***************************************************************************}

{* Handles the keyboard, COM1, COM2, and the modem.

{***************************************************************************}



interface

{***************************************************************************}

function  Disconnected: boolean;

Procedure ErrSayL(InStr: string);

procedure FlushInputBuff(PortNum: integer);

procedure FlushBuffs(PortNum: integer);

function  GetChar(PortNum: integer; var PortChar: char): boolean;

procedure HangUp(PortNum: integer);

procedure InitPort(PortNum: integer);

function  PortInStr(PortNum: integer): string;

procedure PutChar(PortNum: integer; OutChar: char);

procedure PutStr(PortNum: integer; OutStr: string);

procedure Say(SayStr: string);

procedure SayL(SayStr: string);

function  SeeChar(var OutChar: char): boolean;

procedure SendPlusses(PortNum: integer);

Function  SetupModem(PortNum: integer): boolean;

Procedure ShowReplies(PortNum: integer);

Procedure ToModem(PortNum: integer; InStr: string);



implementation

{***************************************************************************}

uses

  BBSGlbls,

  Crt,

  FileIO, {* for ErrSayL *}

  Globals,

  LctBBS,

  LctHayes,

  LctKrnl,

  LctSupp,

  MiscSubs,

  Windows;



function  Disconnected: boolean;

{***************************************************************************}

var

  alpha: integer;

  TempDis: boolean;

begin

  TempDis := false;

  for alpha := 1 to NumPorts do

    if InputFrom[Now, alpha] then

      if (Bit5 and ModemStatus(alpha) = 1) then

        TempDis := true;

  Disconnected := TempDis;

end;



Procedure ErrSayL(InStr: string);

{***************************************************************************}

var

  EL: text;

begin

  SayL(Beep+InStr);

  if FileOpen('A', ErrorLog, EL) = 0 then

    begin

      writeln(EL, InStr);

      close(EL);

    end;

end;



procedure FlushInputBuff(PortNum: integer);

{***************************************************************************}

var

  FlushOK: boolean;

begin

  FlushOK := PurgeRxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeRxBuff failed!!!');

end;





procedure FlushBuffs(PortNum: integer);

{***************************************************************************}

var

  FlushOK: boolean;

begin

  FlushOK := PurgeTxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeTxBuff failed!!!');

  FlushOK := PurgeRxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeRxBuff failed!!!');

end;



function  GetChar(PortNum: integer; var PortChar: char): boolean;

{***************************************************************************}

var

  CharFound: boolean;

  PortByte: byte;

begin

  CharFound := false;

  case PortNum of

    0:  begin

          if keypressed then

            begin

              CharFound := true;

              PortChar := readkey;

            end;

        end;

    1:  begin

          CharFound := LctGet(1, PortByte);

          PortChar := char(PortByte);

        end;

    2:  begin

          CharFound := LctGet(2, PortByte);

          PortChar := char(PortByte);

        end;

    else

      write(#7);

  end; {case}

  GetChar := CharFound;

end;



procedure HangUp(PortNum: integer);

{***************************************************************************}

begin

  SendPlusses(PortNum);

  ToModem(PortNum, 'ATH0');

end;



Procedure InitPort(PortNum: integer);

{***************************************************************************}

const

  BufSize = 1100; {* 1100 is minimum for Y-Modem *}

var

  PortOK: boolean;

  ModemOK: boolean;

begin

  ToWindowL('Initializing Port '+StrInt(PortNum)+'...');

  PortOK := CommOpen(PortNum, 1200, 'N', 8, 1, BufSize, BufSize, true);

  if not(PortOK) then

    begin

      writeln(#7, #7, #7, 'Port ',PortNum,' did not open!!!');

      write('?:');

      readln;

    end;

  ToWindowL('Resetting Port '+StrInt(PortNum)+'''s modem...');

  Delay(0);

  {$R-}

{* I do not know why this creates a range-checking error *}

  ModemOK := SetupModem(PortNum);

  {$R+}

  if not(ModemOK) then

    begin

      writeln(#7, #7, #7, 'Port ', PortNum,'''s modem did not reset!!!');

      writeln(GetModemReply(PortNum));

      write('?:');

      readln;

    end;

end;



function PortInStr(PortNum: integer): string;

{***************************************************************************}

var

  InStr: string;

  InChar: char;

  Done: boolean;

begin

  InStr := '';

  Done := false;

  repeat

    if GetChar(PortNum, InChar) then

      InStr := InStr + InChar

    else

      begin

        Delay(ModemDelay);

        if GetChar(PortNum, InChar) then

          InStr := InStr + InChar

        else

          Done := true;

      end;

    if length(InStr) = 255 then

      Done := true;

    if InChar = CntrlEntr then

      Done := true;

  until Done;

  PortInStr := InStr;

end;



procedure PutChar(PortNum: integer; OutChar: char);

{***************************************************************************}

var

  PutOK: boolean;

  TF: text;

begin

  repeat

  until BytesInOutput(PortNum) < 50;

{*  write(ModemStatus(PortNum),'  ', XoffRecd(PortNum), '     '); *}

  PutOK := LctPut(PortNum, ord(OutChar));

  if not(PutOK) then

    begin

      writeln(#7,#7,#7, 'PutChar was unsuccessful!!!');

      writeln(BytesInOutput(PortNum));

    end;

end;



procedure PutStr(PortNum: integer; OutStr: string);

{***************************************************************************}

begin

  while OutStr <> '' do

    begin

      PutChar(PortNum, OutStr[1]);

      OutStr := copy(OutStr, 2, length(OutStr) - 1);

    end;

end;



procedure Say(SayStr: string);

{***************************************************************************}

var

  alpha, bravo: integer;

begin

  for alpha := 1 to NumPorts do

    if OutputTo[Now, alpha] then

      begin

        while (length(PortOutStr[alpha]) + length(SayStr) > 255) do

          PutOutputs;

        PortOutStr[alpha] := PortOutStr[alpha] + SayStr;

      end;

 ToWindow(SayStr);

end;



procedure SayL(SayStr: string);

{***************************************************************************}

begin

  Say(SayStr + Enter + CntrlEntr);

end;



function SeeChar(var OutChar: char): boolean;

{***************************************************************************}

begin

  if SessInStr[Now] <> '' then

    begin

      SeeChar := true;

      OutChar := SessInStr[Now, 1];

      SessInStr[Now] := copy(SessInStr[Now], 2, length(SessInStr[Now]) - 1);

    end

  else

    SeeChar := false;

end;



procedure SendPlusses(PortNum: integer);

{***************************************************************************}

const

  PlusDelay = 700;

var

  alpha: integer;

begin

  Delay(PlusDelay);

  for alpha := 1 to 3 do

    begin

      PutChar(PortNum, '+');

      Delay(PlusDelay);

    end;

  Delay(ModemDelay);

  ShowReplies(PortNum);

end;



Function  SetupModem(PortNum: integer): boolean;

{***************************************************************************}

var

  PortStr: string;

begin

  ToModem(PortNum, 'AT');

    {* just to clear the air *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'AT&F');

    {* initial factory configuration *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATQ0');

    {* modem returns result codes *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATV1');

    {* full result codes *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATE1');

    {* modem echoes commands *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATF1');

    {* full duplex *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATX4');

    {* wait for dial tone, connect results, display BUSY *}

  ShowReplies(PortNum);

  ToModem(PortNum, 'ATM0');

    {* speaker off *}

  ShowReplies(PortNum);

end;



Procedure ShowReplies(PortNum: integer);

{***************************************************************************}

var

  PortStr: string;

begin

  repeat

    PortStr := PortInStr(PortNum);

    if PortStr <> '' then

      ToWindowL('Modem reply:  "'+PortStr+'"');

  until PortStr = '';

end;



Procedure ToModem(PortNum: integer; InStr: string);

{***************************************************************************}

begin

  FlushBuffs(PortNum);

  Writeln('Sending "',InStr,'" to modem...');

  PutStr(PortNum, InStr + Enter);

  Delay(ModemDelay);

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.