DP Tool Club 8/CDASC08.ISO/NEWS/554/JUIN/EASYFOS.PAS

Pascal/Delphi Source File | 1993-10-07 | 18KB | 581 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 724 of 726
From : John Fulton                         1:355/515.0          27 Jun 93  18:17
To   : Jim Coyle
Subj : Fossil Unit <1/3>
────────────────────────────────────────────────────────────────────────────────
On 24 Jun 93 15:58:00, Jim Coyle Was philosiphizing
To Eric Givler The following|*:

EG>  e) Also found someone interested in helping!
JC>
JC> I might be interested in helping! I wrote my own BBS from the Telegard 2.5i
JC> source and its getting pretty big. Has almost all of the stuff Renegade has
JC> (if you are familure with the two). I don't run it though. Right now I am
JC> looking for some good fossil routines, ya know where I might be able to get
JC> some? I could write my own if I have the format.

All of the fossil specs are included with X00... It's pretty simple to write
one, and I have one here that I wrote. It's pretty basic, and there are a lot
of functions supported by the fossil that I left out because at the time, I
didn't need them. But it should give you a general overview of how a fossil is
written, and mine is VERY clearly documented in the source. I hate it when
others post source but never any specs on the routines. Takes weeks to figure
it out <G>..
                            O  /
----------------------------->< CUT ---------------------------------------
                            O  \}
Unit EasyFos;

{        Easy Fossil v1.0 by John Fulton June 1, 1993
      Copyright (c) 1993 John Fulton. All Rights Reserved.}

INTERFACE
Function InitializeFossil(ComPort:Word):Boolean;
  {Function InitializeFossil must be run first to detect if
   a fossil driver exists, and if so, to initialize it. If the
   fossil exists, and if the initialization was successful, then
   it returns True, else it returns False}
Procedure SetBaudRate(ComPort:Word;Baud:Word;Parity:Char;
                      CharLength:Byte;StopBits:Byte);
  {Procedure SetBaudRate takes ComPort number (in each procedure and
   function, I subtract 1 from this figure to get the actual fossil
   Port number, so if you want COM1, then enter 1, not 0), Baud rates
   300,1200,2400,4800,9600,19200, and 38400 (these baud reats are limited
   not by my programming, but by the fossil driver itself, probally in
   the next revision, support for 300, and 1200 will be dropped for
   2 higher baud rates), Parity as a Charaster either N,n,O,o,E,or e,
   Character length from 5-8, and Stopbits either 1 or 2. Most common
   operation is N,8,1 (or n,8,1).}
Function CarrierDetect(ComPort:Word):Boolean;
  {Returns True if a carrier is detected, False if not.}
Procedure SendCharWait(ComPort:Word;CharToSend:Char);
  {Sends a character into the fossil buffer to be transmitted. If
   there is no room in the buffer, then the procedure waits until
   it can send it. DANGEROUS with Flow control on, See Flow Procedure.}
Function SendChar(ComPort:Word;CharToSend:Char):Boolean;
  {Sends a character into the fossil buffer. If the buffer is full,
   then it returns immediatly with False. If able to transmit the character
   then it returns True.}
Function CharAvail(ComPort:Word):Boolean;
  {Returns True is a character is in the buffer waiting to be recieved.
   False if not.}
Function GetChar(ComPort:Word):Char;
  {Retrives a character from the Fossil Buffer. If no character Available,
   then the Function waits for one. DANGEROUS with Flow control on, See
   Flow Procedure.}
Procedure UnInitializeFossil(ComPort:Word);
  {UnInitializes the Fossil driver for that particular COM port. Does
   NOT drop DTR, so will not hang up.}
Procedure LowerDTR(ComPort:Word);
  {Lower the Data Terminal Ready on the modem. On most modems, will cause
   carrier to drop.}
Procedure RaiseDTR(ComPort:Word);
  {Raises the Data Terminal Ready. This is required before any communications
   can occur between the modem, and computer.}
Function Hangup(Comport:Word):Boolean;
  {Will drop DTR, and then reraise it. If there still is a carrier, then
   it will send +++, wait for a second, and then send ATH0. If
   there is still a carrier, then the function returns False.}
Procedure SendString(ComPort:Word;StrToSend:String;CRLF:Boolean);
   {This will send a string of characters (up to 255 characters) and if
    True is passed to the CRLF varible, the Procedure will add a
    Carrige Return, and a Line Feed on the end of the String. Using
    the SendCharWait Procedure. So IF CRLF is set to TRUE, then there
    is a hazard if Flow control is turned on. See the Flow Procedure.
    If you wish, you could just append a #13#10 to the end of your
    string. I didn't do that just in case if you had a 255 character
    string.}
Procedure GetString(ComPort:Word;StrToGet:String;Count:Word);
   {Will retrive up to Count amount of characters from the fossil buffer.
    if you specify more characters than the buffer holds, then it will send
    all available characters, and pass control back to the program. It will
    NOT wait for more characters. You can specify up to over 64000 because
    the varible Count is a word, BUT since a String haold a MAXIMUM of 255
    characters, IF you specify over 255, it Will over-write parts of memory,
    AND is potentially dangerous if a piece of your code is there when it
    over-writes. In this case, I have specified, that IF you have specified
    over 255, I have written it to only do 255.}
Procedure WaitForEmptyOutBuffer(ComPort:Word);
   {This Procedure will cause your program to pause until ALL data being
    sent is cleared out of the Fossil buffer. DANGEROUS with Flow control
    on, See Flow Procedure.}
Procedure PurgeOutBuffer(ComPort:Word);
   {This Procedure IMMEDIATLY purges all characters remaining in the Outbound
    transmit buffer, and immediatly returns control back to the program.
    Can be used with Flow control. All characters in buffer will be lost.}
Procedure PurgeInBuffer(ComPort:Word);
   {This Procedure IMMEDIATLY purgues all incoming characters from the
    Inbound recieve buffer, and immediatly returns control back to the
program.
    This one again can be used with flow, and all incoming characters are
lost}
Procedure WatchdogOn(ComPort:Word);
   {Turns Watchdog on on the fossil driver. If the fossil detects a carrier
    loss while Watchdog is on, it will reboot the computer. Great for use in
    conjunction with non-carrier detecting doors}
Procedure WatchdogOff(ComPort:Word);
   {Releases Watchdog carrier detection}
Procedure Flow(ComPort:Word; SoftR,SoftT,Hard:Boolean);
   {Flow control is used for high speed modems to tell each other
    to slow down when too much data is being sent over the lines.

    Flow control is dangerous to use is certain instances, so it must at
    some times be turned off.

    Set SoftR to True to enables the sending of an XOFF when the recieving
      buffer is near full.
    Set SoftT to True to enable detection of XOFF while sending data.
    Set Hard to True to enable CTS/RTS flow control which handles both sending
      and recieving flow control. CTS on transmit, and RTS on recieve

    Flow is mostly used during disk writes, and should be shut off
    totally before certain procedures where if software flow (XON/XOFF)
    is used, it might hang the transfer. They are marked for you in
    thier descriptions as DANGEROUS.

    It should be safe to just use Hard flow control alone, as this flow is
    dictated by the modems, and cannot be affected by the data being
    transfered. I never was able to transmit data fast enough to run into
    this problem, so am not positive as to the truth of this.}
Procedure ColdBoot;
  {Will attempt to ColdBoot the computer. May not work on some systems.}
Procedure WarmBoot;
  {Will attempt to WarmBoot the computer. May not work on some systems.}
Procedure StartBreak(ComPort:Word);
  {Starts sending a Break signal. This resets all flow control restraints
   you must Stop the Break signal with either StopBreak, InitializeFossil,
   or UnInitializeFossil procedures}
Procedure StopBreak(ComPort:Word);
  {Stops sending the Break Signal}
Procedure SendBreak(ComPort:Word);
  {Sends a 350 millisecond Break signal}
Function GetStatus(ComPort:Word):Word;
  {Returns a Word containg the status of the specified port. The Word
   Contains the following information:

   Bit 0 if 1 then input data is available in buffer
   Bit 1 if 1 then input buffer overrun
   Bit 2 N/A
   Bit 3 N/A
   Bit 4 N/A
   Bit 5 if 1 then room is available in output buffer
   Bit 6 if 1 then output buffer is empty
   Bit 7 N/A

   Bit 0 N/A
   Bit 1 N/A
   Bit 2 N/A
   Bit 3 is always 1 (enables programs to use it for carrier for null modem)
   Bit 4 N/A
   Bit 5 N/A
   Bit 6 N/A
   Bit 7 if 1 then Carrier Detect

   The first set is the High bit (0000 0000 1111 1111) the second is the
   low bit (1111 1111 0000 0000). Hope you can figure it out, and hope
   you enjoy my fossil routines. 75% of the coding is in assembler for
   speed.}

CONST
  ParityOdd  = $08; {0000 1000 \ }
  ParityEven = $18; {0001 1000  > Parity, used during Baud Rate
Initialization}
  ParityNone = $00; {0000 0000 / }

  Char5  = $00; {0000 0000 \ }
  Char6  = $01; {0000 0001  \Used during Baud Rate Initialization. Sets }
  Char7  = $02; {0000 0010  /the modem's character bits                 }
  Char8  = $03; {0000 0011 / }

  StopBit1 = $00; {0000 0000  Stop bits, what else?                }
  StopBit2 = $04; {0000 0100  Used during Baud Rate Initialization }

  B300    = $40; {0100 0000 \   }
  B600    = $60; {0110 0000  \  }
  B1200   = $80; {1000 0000   \ }
  B2400   = $A0; {1010 0000    \ The Baud reat bits needed for initialization
}
  B4800   = $C0; {1100 0000    / of the baud rate
}
  B9600   = $F0; {1110 0000   / }
  B19200  = $00; {0000 0000  /  }
  B38400  = $20; {0010 0000 /   }
  CDS     = $80; {1000 0000  Carrier Detect Signal Bit used by Status bits }
  OutRoom = $20; {0001 0000  Used in conjunction with the Status Bits,
                             Detects if there is room in the output buffer
                             to send more info into the buffer}
  CA      = $01; {0000 0001  Used in conjunction with the Status Bits,
                             Detects if there is a character waiting to be
                             recieved}

  SoftFlowR= $08; {0000 1000 Enables a watch for XOFF while sending data}
  SoftFlowT= $01; {0000 0001 Enables a send of XOFF when buffer near full}
  HardFlow = $02; {0000 0010 Enables CTS/RTS which handles both}

IMPLEMENTATION
Uses CRT;

Function InitializeFossil(ComPort:Word):Boolean;
VAR
  Result : Word;
BEGIN
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Int 14h
    Mov Result,AX
  END;
  InitializeFossil := Result = $1954;
END;

Procedure SetBaudRate(ComPort:Word;Baud:Word;Parity:Char;
                      CharLength:Byte;StopBits:Byte);
VAR
  Parameters  : Byte;
BEGIN
  CASE Baud of
    300   : Parameters := B300;
    600   : Parameters := B600;
    1200  : Parameters := B1200;
    2400  : Parameters := B2400;
    4800  : Parameters := B4800;
    9600  : Parameters := B9600;
    19200 : Parameters := B19200;
    38400 : Parameters := B38400;
  End;
  CASE Parity of
    'N','n' : Parameters := Parameters OR ParityNone;
    'E','e' : Parameters := Parameters OR ParityEven;
    'O','o' : Parameters := Parameters OR ParityOdd;
  END;
  CASE CharLength of
    5 : Parameters := Parameters OR Char5;
    6 : Parameters := Parameters OR Char6;
    7 : Parameters := Parameters OR Char7;
    8 : Parameters := Parameters OR Char8;
  END;
  CASE StopBits of
    1 : Parameters := Parameters OR StopBit1;
    2 : Parameters := Parameters OR StopBit2;
  END;
  ASM
    Sub ComPort,1
    Mov AH,00h
    Mov AL,Parameters
    Mov DX,ComPort
    Int 14h
  END;
END;

Function CarrierDetect(ComPort:Word) : Boolean;
VAR
  Status : Byte;
BEGIN
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AH,03h
    Int 14h
    Mov Status,AL
  END;
  CarrierDetect := (Status AND CDS) = CDS;
END;

Procedure SendCharWait(ComPort:Word;CharToSend:Char);
VAR
  CharOrdinal : Byte;
BEGIN
  CharOrdinal := Ord(CharToSend);
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AL,CharOrdinal
    Mov AH,01h
    Int 14h
  END;
END;

Function SendChar(ComPort:Word;CharToSend:Char):Boolean;
VAR
  CharOrdinal   : Byte;
  Success       : Word;
BEGIN
  CharOrdinal := Ord(CharToSend);
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AL,CharOrdinal
    Mov AH,0Bh
    Int 14h
    Mov Success,AX
  END;
  If Success >= 1 then
    SendChar := True
  ELSE
    SendChar := False;
END;

Function CharAvail(ComPort:Word):Boolean;
VAR
  Status : Byte;
BEGIN
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AH,03h
    Int 14h
    Mov Status,AH
  END;
  CharAvail := (Status AND CA) = CA;
END;

Function GetChar(ComPort:Word):Char;
VAR
  CharRecieved : Byte;
BEGIN
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AH,02h
    Int 14h
    Mov CharRecieved,AL
  END;
  GetChar := Chr(CharRecieved);
END;

Procedure UnInitializeFossil(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,05
  Int 14h
END;

Procedure LowerDTR(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,06h
  Mov AL,00h
  Int 14h
END;

Procedure RaiseDTR(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,06h
  Mov AL,01h
  Int 14h
END;

Function Hangup(Comport:Word):Boolean;
VAR
  Status : Byte;
BEGIN
  LowerDTR(Comport);
  delay (600);
  RaiseDTR(Comport);
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AH,03h
    Int 14h
    Mov Status,AL
  END;
  If ((Status AND CDS) = CDS) Then
    BEGIN
      Flow(ComPort+1,False,False,False);
      SendString(Comport+1,'+++',False);
      delay(1000);
      SendString(Comport+1,'ATH0',True);
      delay(1000);
      ASM
        Mov DX,ComPort
        Mov AH,03h
        Int 14h
        Mov Status,AL
      END;
    END;
  HangUp := not ((Status AND CDS) = CDS)
END;

Procedure SendString(ComPort:Word;StrToSend:String;CRLF:Boolean);
VAR
  StrSeg,
  StrOfs,
  StrLgn : Word;
BEGIN
  StrLgn := Length(StrToSend);
  StrSeg := Seg(StrToSend);
  StrOfs := Ofs(StrToSend)+1;
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov CX,StrLgn
    Mov ES,StrSeg
    Mov DI,StrOfs
    Mov AH,19h
    Int 14h
  END;
  If CRLF Then
    BEGIN
      SendCharWait(ComPort+1,#13);
      SendCharWait(ComPort+1,#10);
    END;
END;

Procedure GetString(ComPort:Word;StrToGet:String;Count:Word);
VAR
  StrSeg,
  StrOfs,
  CharsGot  : Word;
BEGIN
  If Count > 255 then Count := 255;
  StrSeg := Seg(StrToGet);
  StrOfs := Ofs(StrToGet)+1;
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov CX,Count
    Mov ES,StrSeg
    Mov DI,StrOfs
    Mov AH,18h
    Int 14h
    Mov CharsGot,AX
  END;
  StrToGet[0] := Chr(CharsGot);
END;

Procedure WaitForEmptyOutBuffer(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov AH,08h
  Mov DX,ComPort
  Int 14h
END;

Procedure PurgeOutBuffer(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov AH,09h
  Mov DX,ComPort
  Int 14h
END;

Procedure PurgeInBuffer(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,0Ah
  Int 14h
END;

Procedure WatchdogOn(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AL,01h
  Mov AH,14h
  Int 14h
END;

Procedure WatchdogOff(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AL,00h
  Mov AH,14h
  Int 14h
END;

Procedure Flow(ComPort:Word; SoftR,SoftT,Hard:Boolean);
VAR
  FlowBit : Byte;
BEGIN
  FlowBit := $F0; {High nibble toggled all on for compatibility with certain
                   Fossil Drivers}
  If SoftT then FlowBit := FlowBit + SoftFlowT;
  If SoftR then FlowBit := FlowBit + SoftFlowR;
  If Hard  then FlowBit := FlowBit + HardFlow;
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AL,FlowBit
    Mov AH,0Fh
    Int 14h
  END;
END;

Procedure ColdBoot; Assembler;
ASM
  Mov AL,00h
  Mov AH,17h
  Int 14h
END;

Procedure WarmBoot; Assembler;
ASM
  Mov AL,01h
  Mov AH,17h
  Int 14h
END;

Procedure StartBreak(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,1Ah
  Mov AL,01h
  Int 14h
END;

Procedure StopBreak(ComPort:Word); Assembler;
ASM
  Sub ComPort,1
  Mov DX,ComPort
  Mov AH,1Ah
  Mov AL,00h
  Int 14h
END;

Procedure SendBreak(ComPort:Word);
BEGIN
  StartBreak(ComPort);
  Delay(350);
  StopBreak(ComPort);
END;

Function GetStatus(ComPort:Word):Word;
VAR
  Status:Word;
BEGIN
  ASM
    Sub ComPort,1
    Mov DX,ComPort
    Mov AH,03h
    Int 14h
    Mov Status,AX
  END;
  GetStatus := Status;
END;

BEGIN
  Writeln('       Easy Fossil written by John Fulton. June 1, 1993.');
  Writeln('      Copyright (c) 1993 John Fulton. All Rights Reserved.');
  Writeln('            This message removed with registration.');
  Delay(500);
END.

                              O  /
------------------------------->< CUT --------------------------------------
                              O  \

Finally finished... You can probally remove the delay at the end... I was
planning on distributing it, but with as many better fossil units out there. I
probally wouldn't get much for it, and I don't have the time to revamp it and
make it better. I had planned on making it all in ASM, but have other projects
to work on... Hope you enjoy it, and hope it'll help you create your own.. You
can modify and use this one, and don't worry about putting my name in it. I
have many other things that are better quality..