Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/JBCOMM12.ZIP/JBCOMM11.DOC

Text File | 1988-01-15 | 9.3 KB | 285 lines

    {JBCOMM:v1.1 by Jim Berg, (c)Copyright 1988 }


{

   The following procedures and functions are to assist the general
   public with communications programming in Turbo Pascal v4.0.  Feel
     free to use these routines in your private programs or programs
     intended for the Public Domain.  If you intend to use these routines
     in a program that you will receive money for, be it Shareware,
     Commercial, or part of your professional program library, you must
     send $15 to:

              Jim Berg
                            650 Minnetonka Highland Lane
                            Long Lake, MN 55356

   If you find any bugs or have any suggestions, please feel free to
     write, or leave me a message on Terrapin Station, [phone].

             ********* DISCLAIMER *************

   If something goes wrong with your hardware while using this library,
     I hereby free myself from any liability with this disclaimer.  As far
     as I know, these routines work.  If something does go wrong, please
     contact me anyway so I may attempt to fix the program.

}




unit comm;

interface

uses crt,dos;

const
        { constants for Modem Status }

         c_DCTS            = 1;   { Delta Clear to Send              }
         c_DDSR            = 2;   { Delta Data Set Ready             }
         c_TERI            = 4;   { Trail End Ring Indicator         }
         c_DRLSD           = 8;   { Delta Receive Line Signal Detect }
         c_CTS             = 16;  { Clear To Send                    }
         c_DSR             = 32;  { Data Set Ready                   }
         c_RI              = 64;  { Ring Indicator                   }
         c_RLSD            = 128; { Receive Line Signal Detect       }

        { constants for Line Status  }

     c_DR              = 1;   { Data Ready      }
         c_OR              = 2;   { Overrun         }
         c_PE              = 4;   { Parity Error    }
         c_FE              = 8;   { Framing Error   }
         c_BI              = 16;  { Break Interrupt }
         c_THRE            = 32;  { Transmitter Holding Register Empty }
         c_TSRE            = 64;  { Transmitter Shift Register Empty   }
         c_BO              = 128; { Input Buffer Overflow              }

        { constants for last interrupt }

     c_NONE            = 1;
     c_DATA_READY      = 4;
     c_THR_EMPTY       = 2;
         c_LINE_STATUS     = 6;
         c_MODEM_STATUS    = 0;

type porttype          = (com1,com2);
{ *** NEW v1.1 *** }
     parityt           = (p_none,p_even,p_odd,p_even_stick,p_odd_stick);
     comstr            = string[255];
         checkstr          = string[20];
{ *** NEW v1.1 *** }
         com_info_rec      = record
                                                     offset,
                                                     speed   : word;
                                                     parity  : parityt;
                                                     data,
                                                     stops   : byte;
                                                     active,
                                                     ints_on : boolean
                                                 end;


{ ***************************************************************
  CALLING SOME OF THE ROUTINES BELOW WITHOUT OPENING THE COM PORT
    FIRST MAY CAUSE SOME UNNATURAL THINGS TO OCCUR.
    *************************************************************** }


{ This sets the speed of the serial port to whatever speed you want.
  It doesn't check the speed so any speed is legal, some of which may
    be HARMFUL TO YOUR HARDWARE.  Keep below 19.2kbaud if possible.     }

procedure c_set_speed  (cp       : porttype;
                        speed    : word     );

{ Sets the parity,number of data bits and stop bits.  If number of data
  or stop bits are out of range, data will be 8, or stops will be 1.   }

procedure c_set_uart   (cp       : porttype;
                        parity   : parityt;
                                                data,
                                                stops    : byte    );

{ Open the COM port with speed and uart settings.  Create an receive buffer
  of size IBUFFS and a transmit buffer of size OBUFFS. All settings will
    be ignored if the port is already open                                   }

procedure c_open       (cp       : porttype;
                        speed    : word;
                                                parity   : parityt;
                                                data,
                                                stops    : byte;
                                                ibuffs,
                                                obuffs   : word     );

{ Close the COM port. If DROPDTR=TRUE, the port will be completely closed,
  if it is FALSE, the interrupts will be turned off, and the port will
    remain active.  That is useful for EXEC or DOORS type programs.         }

procedure c_close      (cp       : porttype;
                        dropdtr  : boolean  );

{ Returns the number of characters waiting in the receive buffer. }

function  c_inready    (cp       : porttype ) : word;

{ Returns the number of characters remaining in the transmit buffer. }

function  c_outready   (cp       : porttype ) : word;

{ Send character through serial port.}

procedure c_putc       (cp       : porttype;
                        ch       : char     );

{ Insert character into receive buffer. }

procedure c_insertc    (cp       : porttype;
                        ch       : char     );

{ Insert String into receive buffer. A '|' translates to a Carriage Return. }

procedure c_inserts    (cp       : porttype;
                        outstr   : comstr   );

{ Wait indefinately for character and return it. }

function  c_getc       (cp       : porttype ) : char;

{ Wait indefinately for character and return it without removing it from the
  receive buffer. }

function  c_peekc      (cp       : porttype ) : char;

{ Reset Received Buffer }

procedure c_flush_in   (cp       : porttype );

{ Reset Transmit Buffer }

procedure c_flush_out  (cp       : porttype );

{ Return True if a carrier is present. }

function  c_carrier    (cp       : porttype ) : boolean;

{ Toggle the DTR.  Dropping the DTR will hangup the modem if it is set up
  right.                                                                 }

procedure c_toggle_DTR (cp       : porttype );

{ Send a break for duration milliseconds }

procedure c_send_break (cp       : porttype;
                        duration : word     );

{ Send a string over serial port.  '|' is a carriage return, and the '~' is
  a 1/4 second delay                                                        }

procedure c_puts       (cp       : porttype;
                        outstr   : comstr   );

{ Wait timeout 1/100s of a second of time to Get a byte from the serial port.
  Will be -1 on timeout or the ascii value. }

function  c_getb       (cp       : porttype;
                        timeout  : word     ) : integer;

{ Will return true if chkstr  is received before the line is quiet for
  timeout hundreds of a second, or false if a timeout occurs.}

function  c_waits      (cp       : porttype;
                        chkstr   : checkstr;
                                                timeout  : word     ) : boolean;

{ Waits until a string in clst is received or the line is quiet for
  timeout 1/100s of a second. CLST is an array of [1..n] of checkstr.
    It will either return the number of the string that matched, or a
    -1 to indicate a timeout                                            }

function  c_waitsn     (cp       : porttype;
                        var clst;
                                                n        : byte;
                                                timeout  : word     ) : integer;

{ This will grab n number of characters out of the receive buffer and put
  them into getbuf.  It   won't wait for n characters though.  It will
    return the number of     characters in could fetch.                    }

function  c_get_stream (cp       : porttype;
                        var getbuf;
                                                n        : word     ) : word;

{ *** NEW v1.1 *** }

{ This will grab n number of characters out of the receive buffer and put
  them into getbuf.  It will try to wait for n characters, timeout amount of
    time.  It will return the number of characters in could fetch.      }

function  c_tget_stream(cp       : porttype;
                        var getbuf;
                                                n,
                                                timeout  : word     ) : word;

{ This will put n number of characters in putbuf into the transmit buffer.
  If the the transmit buffer is full, it will return.  It returns the number
    of characters put on the buffer. }

function  c_put_stream (cp       : porttype;
                        var putbuf;
                                                n        : word     ) : word;

{ Returns TRUE if XOFF was received from serial port }

function  c_XOFF_received(cp     : porttype ) : boolean;

{ Returns TRUE if buffer got overflowed and sent an XOFF over the serial
  port. }

function  c_XOFF_sent  (cp       : porttype ) : boolean;

{ Turn on XON/XOFF support. }

procedure c_XON_XOFF   (cp       : porttype;
                        on       : boolean  );

{ Returns last modem status }

function  c_statusm    (cp       : porttype ) : byte;

{ Returns last line status  }

function  c_statusl    (cp       : porttype ) : byte;

{ Return last interrupt information }

function  c_lastint    (cp       : porttype ) : byte;

{ *** NEW v1.1 *** }

{ This routine will return the current port status for comport cp in the
  record info.    }

procedure c_port_info  (cp       : porttype;
                        var info : com_info_rec);

{ Calculate a CRC }

function  CRC_update   (crc      : word;
                        b        : byte     ) : word;

{ *** NEW v1.1 *** }

{ Calculates CRC for a block of n bytes }

function  block_CRC    (var block;
                        n        : word     ) : word;


implementation