[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

     (* °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* °°ÛÛÛÛÛÛ°°°°°°°°°°°°°°°°°°°°°ÛÛÛÛÛÛ°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* °°Û      °°°°°°°°°°°°°°°°°°°°Û      °°°°°°°°°°ú              ú°°°°°  *)
     (* °°ÛÛÛÛÛÛ Û°°Û°ÛÛÛÛ°ÛßßÛ°ÛÜÛÛ°ÛÛÛ°°ÛÛÛÛ°Ûßßß°°° By Wayne Boyd  ±°°°°  *)
     (* °°°    Û Û °Û Û  Û Ûßßß Û    Û   °Û  Û ßßßÛ°°° Fido 1:153/763 ±°°°°  *)
     (* °°ÛÛÛÛÛÛ ÛÛÛÛ ÛÛÛÛ ÛÛÛÛ Û °°°Û °°°ÛÛÛÛ ÛÛÛÛ °°ú              ú±°°°°  *)
     (* °°°      °    Û    °    ° °°°° °°°°    °    °°°±±±±±±±±±±±±±±±±°°°°  *)
     (* °°°°°°°°°°°°°°Û °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°° °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°ú A Turbo Pascal Unit for   ú°°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°  modem communications using ±°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°ú a FOSSIL driver.          ú±°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°°±±±±±±±±±±±±±±±±±±±±±±±±±±±±±°°°°°°°°°°°°°°°°  *)
     (* °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°  *)
     (* Welcome to my fossil driver world. After struggling for a long       *)
     (* time with various communications drivers I came to realize the       *)
     (* easiest way to go about writing doors and even BBS programs was to   *)
     (* use a FOSSIL driver. FOSSIL stands for Fido Opus Seadog Standard     *)
     (* Interface Layer. It's a TSR program that remains in your computer    *)
     (* memory and helps interface your software with the modem com port.    *)
     (* There's many BBS programs, Fidonet mailer's and On-line BBS games    *)
     (* that only operate with a FOSSIL driver loaded. The programs you      *)
     (* write with this unit will also depend on a FOSSIL driver.            *)
     (* Of course, there is no FOSSIL driver included with this package.     *)
     (* You have to pick one of those up on your own at most major           *)
     (* computer bulletin boards around country. I've tested this unit on    *)
     (* X00, BNU and OPUSCOMM and they work fine. The unit that is           *)
     (* included here is more a less a complete package. You could write a   *)
     (* BBS or a door with it easily. I've written many doors now, and       *)
     (* this is my standard unit. I don't want to claim credit for           *)
     (* everything here. In fact, the function calls used are from the       *)
     (* fossil revision 5 documentation and will work with any proper        *)
     (* FOSSIL driver.                                                       *)
     (*                                                                      *)
     (* = It is important to note that this unit was specifically written to *)
     (* = facilitate writing of BBS doors, but may be modified slightly to   *)
     (* = facilitate the writing of a BBS program itself. The difference is  *)
     (* = that generally when writing a door, if the caller drops carrier    *)
     (* = you would simply want the program to terminate and return to the   *)
     (* = BBS. In the case of a BBS, however, you want the BBS to recycle,   *)
     (* = not to terminate. Also, with some doors, rather than terminate     *)
     (* = immediately, you would want them to save information to file       *)
     (* = first. In such cases you have to modify all of the HALT statements *)
     (* = that are found within this unit to reflect your actual needs.      *)
     (*                                                                      *)
     (* I have provided this unit as a public service for the BBS community, *)
     (* but I do request that if you would like further support for programs *)
     (* that you write with this unit, that you register this unit with me   *)
     (* by sending me a modest donation of $25.00.                           *)
     (*                                                                      *)
     (* I may be contacted by writing:                                       *)
     (*                        ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿                     *)
     (*                        ³ Wayne Boyd            ³                     *)
     (*                        ³ c/o Vipramukhya Swami ³                     *)
     (*                        ³ 5462 SE Marine Drive  ³                     *)
     (*                        ³ Burnaby, BC, V5J 3G8  ³                     *)
     (*                        ³ Canada                ³                     *)
     (*                        ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ                     *)
     (* My BBS is called Sita and the Ring BBS, and it is Fidonet node       *)
     (* 1:153/763, Transnet node 132:732/4 and ISKCONet 108:410/8. File      *)
     (* requests and netmail is acceptable. You may also log on my board at  *)
     (* 2400 baud or less, and the phone number is (604)431-6260.            *)
     (*                                                                      *)

    UNIT SuperFos;

    INTERFACE

    USES Dos,Crt,ansi;
                 { this ANSI module is in ANSI.SWG.  }
    CONST

      { These are defined global constants that can be passed to SetPort }

      Com0 = 0;  { local only mode }
      Com1 = 1;  { for COM1, etc.  }
      Com2 = 2;
      Com3 = 3;
      Com4 = 4;

    PROCEDURE SetPort(Port : Integer);
     (*   Set's ComPortNum to correct value, used by all procedures. Must be *)
     (*   called first. Use the defined constants to make it easy. For       *)
     (*   example: SetPort(Com1) will assign COM1 as the input/output port.  *)
     (*   In reality, the numeric value of ComPortNum is (Port - 1).         *)
     (*   Calling SetPort with a 0 will cause all functions and              *)
     (*   procedure to function in local mode. You must make one call to     *)
     (*   SetPort at the beginning of your program before using any of the   *)
     (*   procedures or functions in this unit.                              *)
     (*                                                                      *)
     (*   If you use                                                         *)
     (*   SetPort(Com0), all functions and procedures will function in local *)
     (*   mode, since Com0 = 0. This will cause the value of ComPortNum to   *)
     (*   equal -1.                                                          *)

    PROCEDURE SetBaudRate(A : LongInt);
     {  Set baud rate, 300/600/1200/2400/4800/9600/19200/38400 supported}

    PROCEDURE TransmitChar(A : Char);
     {  Character is queued for transmission}

    FUNCTION TxCharNoWait(A : Char) : BOOLEAN;
     {  Try to send char.  Returns true if sent, false if buffer full}

    FUNCTION ReceiveChar : Char;
     {  Next char in input buffer returned, waits if none avail}

    FUNCTION SerialStatus : Word;
    {  AH bit 6, 1=output buffer empty
       AH bit 5, 1=output buffer not full
       AH bit 1, 1=input buffer overrun
       AH bit 0, 1=characters in input buffer
       AL bit 7, 1=carrier detect
       AL bit 3, 1=always}
    FUNCTION KeyPressedPort : Boolean;
      { Similar to KEYPRESSED. Returns TRUE if there is a character waiting in
      the input port. Uses the SerialStatus function above. }

    FUNCTION OutBufferFull : Boolean;
      { Returns TRUE if the Output Buffer is full. }

    FUNCTION OutBufferEmpty : Boolean;
      { Returns TRUE if the Output Buffer is empty. }

    FUNCTION OpenFossil : Boolean;
     {  Open & init fossil. Returns true if a fossil device is loaded }

    PROCEDURE CloseFossil;
     {  Disengage fossil from com port. DTR not changed}

    PROCEDURE SetDTR(A : Boolean);
     {  Raise or lower DTR}

    PROCEDURE FlushOutput;
     {  Wait for all output to complete}

    PROCEDURE PurgeOutput;
     {  Zero output buffer and return immediately. Chars in buffer lost}

    PROCEDURE PurgeInput;
     {  Zero input buffer and return immediately.  Chars in buffer lost}

    FUNCTION CarrierDetect : Boolean;
     {  Returns true if there is carrier detect }

    FUNCTION SerialInput : Boolean;
     {  Returns true if there is a character ready to be input }

    PROCEDURE WriteChar(c : Char);
     {  Write char to screen only with ANSI support}

    PROCEDURE FlowControl(A : Byte);
     {  Enable/Disable com port flow control}

    PROCEDURE WritePort(s : string);
     {  Write string S to the comport and echo it to the screen. Checks if the
       buffer is full, and if it is, waits until it is available. If Carrier is
       dropped, this procedure will halt the program.}

    PROCEDURE WritelnPort(s : string);
     { Same as WritePort, but adds a linefeed + CarrierReturn to the end of S }

    FUNCTION ReadKeyPort : char;
     { Like pascal's Readkey.
      Example:
      var
        ch : char;
      begin
        repeat
          ch := upcase(readkeyport);
        until ch in ['Y','N'];
      end.
    }

    PROCEDURE ReadPort(var C : char);
     { Similar to Pascal's Read(ch : char); This procedure will read the
      comport until a character is received. If no carrier is received it
      will wait and eventually time out. If carrier is dropped it will halt
      the program. The character is echoed to the local screen with ansi
      support.

      EXAMPLE
      var
        ch : char;
      begin
        ReadPort(Ch);
      end.
    }

    PROCEDURE ReadlnPort(var S : string);
     { Similar to Pascal's Readln(s : string); This procedure will read the
      comport until a carriage return is received, and assign the value to S.
      Carrier detect monitoring is enabled, and if the carrier is dropped the
      program will halt. Also there is a time out function. The characters
      are echoed to the local screen with ansi support.

      Example:
        var
          Rspns : string;
        begin
          ReadlnPort(Rspns);  (* read a string from comport and store in Rspns *)
        end.
    }

    PROCEDURE HangUp;
     {  Hangs up on the caller by lowering DTR until carrier is dropped, and then
       raising DTR again. }

    VAR
      Reg : Registers;  { Saves on stack usage later }

     {-------------------------------------------------------------------------}

    IMPLEMENTATION

    Const
      TimeOut = 20000;

    VAR
      Status : Word;
      bt : byte;
      ComPortNum : Integer;

    PROCEDURE SetPort(Port : Integer);
    BEGIN
      ComPortNum := Port - 1;
    END;

    FUNCTION BitOn(Position, TestByte : Byte) : Boolean;
     {
    This function tests to see if a bit in TestByte is turned on (equal to one).
    The bit to test is indicated by the parameter Position, which can range from 0
    (right-most bit) to 7 (left-most bit). If the bit indicated by Position is
    turned on, the BitOn function returns TRUE.
    }
    BEGIN
      bt := $01;
      bt := bt SHL Position;
      BitOn := (bt AND TestByte) > 0;
    END;

    PROCEDURE SetBaudRate(A : LongInt);
    BEGIN
      IF ComPortNum < 0 then exit;
      WITH Reg DO BEGIN
        AH := 0;
        DX := ComPortNum;
        AL := $63;
        IF A=38400 THEN AL:=$23 ELSE
        CASE A OF
          300   : AL := $43;
          600   : AL := $63;
          1200  : AL := $83;
          2400  : AL := $A3;
          4800  : AL := $C3;
          9600  : AL := $E3;
          19200 : AL := $03;
        END;
        Intr($14, Reg);
      END;
    END;

    PROCEDURE TransmitChar(A : Char);
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := 1;
      Reg.DX := ComPortNum;
      Reg.AL := Ord(A);
      Intr($14, Reg);
    END;

    FUNCTION TxCharNoWait(A : Char) : BOOLEAN;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := $0B;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
      TxCharNoWait := (Reg.AX = 1);
    END;

    FUNCTION ReceiveChar : Char;
    BEGIN
      IF ComPortNum < 0 then ReceiveChar := readkey else
      begin
        Reg.AH := 2;
        Reg.DX := ComPortNum;
        Intr($14,Reg);
        ReceiveChar := Chr(Reg.AL);
      end;
    END;

    FUNCTION SerialStatus : Word;
    BEGIN
      Reg.AH := 3;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
      SerialStatus := Reg.AX;
    END;

    FUNCTION KeyPressedPort : Boolean;
     {
    Similar to KEYPRESSED. Returns TRUE if there is a character waiting in the
    input port. Uses the SerialStatus function above.
    }
    VAR
      Status : Word;
      NextByte : byte;
    begin
      IF ComPortNum < 0 then KeyPressedPort := Keypressed else
      begin
        Status := SerialStatus;
        NextByte := hi(Status);
        KeyPressedPort := BitOn(0,NextByte);
      end;
    end;

    FUNCTION OutBufferFull : Boolean;
     { Returns TRUE if the Output Buffer is full. }
    begin
      IF ComPortNum < 0 then OutBufferFull := false else
      begin
        Status := SerialStatus;
        bt := hi(Status);
        OutBufferFull := (BitOn(5,bt) = FALSE);
      end;
    end;

    FUNCTION OutBufferEmpty : Boolean;
     { Returns TRUE if the Output Buffer is empty. }
    begin
      IF ComPortNum < 0 then OutBufferEmpty := true else
      begin
        Status := SerialStatus;
        bt := hi(Status);
        OutBufferEmpty := BitOn(6,bt);
      end;
    end;

    FUNCTION OpenFossil : boolean;
    BEGIN
      if ComPortNum < 0 then OpenFossil := true else
      begin
        Reg.AH := 4;
        Reg.DX := ComPortNum;
        Intr($14,Reg);
        OpenFossil := Reg.AX = $1954;
      end;
    END;

    PROCEDURE CloseFossil;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := 5;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
    END;

    PROCEDURE SetDTR;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := 6;
      Reg.DX := ComPortNum;
      Reg.AL := Byte(A);
      Intr($14,Reg);
    END;

    PROCEDURE FlushOutput;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := 8;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
    END;

    PROCEDURE PurgeOutput;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := 9;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
    END;

    PROCEDURE PurgeInput;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := $0A;
      Reg.DX := ComPortNum;
      Intr($14,Reg);
    END;

    FUNCTION CarrierDetect;
    BEGIN
      IF ComPortNum < 0 then CarrierDetect := true else
      begin
        Reg.AH := 3;
        Reg.DX := ComPortNum;
        Intr($14,Reg);
        CarrierDetect := (Reg.AL AND $80) > 0;
      end;
    END;

    FUNCTION SerialInput;
    BEGIN
      IF ComPortNum < 0 then SerialInput := true else
      begin
        Reg.AH := 3;
        Reg.DX := ComPortNum;
        Intr($14,Reg);
        SerialInput := (Reg.AH And 1) > 0;
      end;
    END;

    PROCEDURE WriteChar(c : char);
    BEGIN
      if ComPortNum < 0 then Display_Ansi(c) else
      begin
        Reg.AH := $13;
        Reg.AL := ORD(c);
        Intr($14,Reg);
      end;
    END;

    PROCEDURE FlowControl;
    BEGIN
      IF ComPortNum < 0 then exit;
      Reg.AH := $0F;
      Reg.DX := ComPortNum;
      Reg.AL := A;
      Intr($14, Reg);
    END;

    PROCEDURE WritePort(s : string);
    VAR
      i : byte;
    begin
      for i := 1 to length(s) do
      begin
        if (ComPortNum >= 0) then TransmitChar(s[i]);
        DISPLAY_Ansi(s[i]);
        if not CarrierDetect then halt(1);
      end;
    end;

    PROCEDURE WritelnPort(s : string);
    BEGIN
      s := s + #10 + #13;
      WritePort(s);
    end;

    FUNCTION ReadKeyPort : char;
    var
      ch : char;
      count : longint;
    begin
      count := 0;
      repeat
        if not carrierdetect then exit;
        if ComPortNum < 0 then ch := readkey else
        if KeyPressedPort then ch := ReceiveChar else
         if keypressed then ch := readkey else
          ch := #0;
        if ch = #0 then inc(count);
      until (ch > #0) or (count > timeout);
      ReadKeyPort := ch;
    end;

    PROCEDURE ReadPort(var C : char);
    type
      C_Type = char;
    var
      CPtr : ^C_Type;
      ch : char;
      count : longint;
    begin
      CPtr := @C;
      count := 0;
      repeat
        if not carrierdetect then halt(1);
        if ComPortNum < 0 then ch := readkey else
         if KeyPressedPort then ch := ReceiveChar else
          if keypressed then ch := readkey else
           ch := #0;
        if ch = #0 then inc(count) else
        begin
          if (ComPortNum >= 0) then TransmitChar(ch);
          DISPLAY_Ansi(ch);
        end;
      until (ch > #0) or (count > timeout);

      CPtr^ := ch;
    end;

    PROCEDURE ReadlnPort(var S : string);
    type
      linestring = string;
    var
      SPtr : ^linestring;
      st : string;
      ch : char;
    begin
      SPtr := @S;
      st := '';

      repeat
        Ch := readkeyport;
        if ch in [#32..#255] then
        begin
          st := st + ch;
          writeport(ch);
        end else
        if (ch = #8) and (st > '') then
        begin
          delete(st,length(st),1);
          writeport(#8+#32+#8);
        end;
      until ch in [#13,#0];   { will equal NULL if ReadPort timed out }
      WritelnPort('');
      SPtr^ := st;
    end;

    PROCEDURE HangUp;
    BEGIN
      if ComPortNum < 0 then exit;
      repeat
        SetDtr(TRUE);        { lower DTR to hangup }
      until Not CarrierDetect;
      SetDtr(FALSE);           { raise DTR again     }
    END;

    BEGIN
      Clrscr;
      Write('SuperFos - by Wayne Boyd 1:153/763');
      delay(1000);
    END.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]