[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
{
STEVE GABRILOWITZ
> I was wondering if anyone had any routines they could send me or tell
> me where to find some routines that show you have to use the
> fossil I have a file on my BBS called TPIO_100.ZIP,
}
Unit IO;
{ FOSSIL communications I/O routines }
{ Turbo Pascal Version by Tony Hsieh }
{}{}{}{ Copyright (c) 1989 by Tony Hsieh, All Rights Reserved. }{}{}{}
{ The following routines are basic input/output routines, using a }
{ fossil driver. These are NOT all the routines that a fossil }
{ driver can do! These are just a portion of the functions that }
{ fossil drivers can do. However, these are the only ones most }
{ people will need. I highly recommend for those that use this }
{ to download an arced copy of the X00.SYS driver. In the arc }
{ is a file called "FOSSIL.DOC", which is where I derived my }
{ routines from. If there are any routines that you see are not }
{ implemented here, use FOSSIL.DOC to add/make your own! I've }
{ listed enough examples here for you to figure out how to do it }
{ yourself. }
{ This file was written as a unit for Turbo Pascal v4.0. You }
{ should compile it to DISK, and then in your own program type }
{ this right after your program heading (before Vars and Types) }
{ this: "uses IO;" }
{ EXAMPLE: }
{
Program Communications;
uses IO;
begin
InitializeDriver;
Writeln ('Driver is initalized!');
ModemSettings (1200,8,'N',1); Baud := 1200;
DTR (0); Delay (1000); DTR (1);
Writeln ('DTR is now true!');
CloseDriver;
Writeln ('Driver is closed!');
end.
}
{ Feel free to use these routines in your programs; copy this }
{ file freely, but PLEASE DO NOT MODIFY IT. If you do use }
{ these routines in your program, please give proper credit to }
{ the author. }
{ }
{ Thanks, and enjoy! }
{ }
{ Tony Hsieh }
INTERFACE
uses
DOS;
{ These are communications routines }
{ that utilize a FOSSIL driver. A }
{ FOSSIL driver MUST be installed, }
{ such as X00.SYS and OPUS!COM... }
type
String255 = String [255];
var
Port : Integer; { I decided to make 'Port' a global }
{ variable to make life easier. }
Baud : Word; { Same with Baud }
RegistersRecord: Registers; { DOS registers AX, BX, CX, DX, and Flags }
procedure BlankRegisters;
procedure ModemSettings(Baud, DataBits : Integer; Parity : Char;
Stopbits : Integer);
procedure InitializeDriver;
procedure CloseDriver;
procedure ReadKeyAhead (var First, Second : Char);
function ReceiveAhead (var Character : CHAR) : Boolean;
function Online : boolean;
procedure DTR(DTRState : Integer);
procedure Reboot;
procedure BiosScreenWrite(Character: CHAR);
procedure WatchDog(INPUT : Boolean);
procedure WhereCursor(var Row : Integer; var Column : Integer);
procedure MoveCursor(Row : Integer; Column : Integer);
procedure KillInputBuffer;
procedure KillOutputBuffer;
procedure FlushOutput;
function InputAvailable : Boolean;
function OutputOkay : Boolean;
procedure ReceiveCharacter(var Character : CHAR);
procedure TransmitCharacter(Character : CHAR; var Status : Integer);
procedure FlowControl(Control : Boolean);
procedure CharacterOut(Character : CHAR);
procedure StringOut(Message : String255);
procedure LineOut(Message : String255);
procedure CrOut;
IMPLEMENTATION
procedure BlankRegisters;
begin
Fillchar(RegistersRecord, SizeOf(RegistersRecord), 0);
end;
procedure ModemSettings (Baud, DataBits : Integer; Parity : Char;
StopBits : Integer);
{ Do this after initializing }
{ the FOSSIL driver and also }
{ when somebody logs on }
var
GoingOut: Integer;
begin
GoingOut := 0;
Case Baud of
0 : Exit;
100 : GoingOut := GoingOut + 000 + 00 + 00;
150 : GoingOut := GoingOut + 000 + 00 + 32;
300 : GoingOut := GoingOut + 000 + 64 + 00;
600 : GoingOut := GoingOut + 000 + 64 + 32;
1200: GoingOut := GoingOut + 128 + 00 + 00;
2400: GoingOut := GoingOut + 128 + 00 + 32;
4800: GoingOut := GoingOut + 128 + 64 + 00;
9600: GoingOut := GoingOut + 128 + 64 + 32;
end;
Case DataBits of
5: GoingOut := GoingOut + 0 + 0;
6: GoingOut := GoingOut + 0 + 1;
7: GoingOut := GoingOut + 2 + 0;
8: GoingOut := GoingOut + 2 + 1;
end;
Case Parity of
'N' : GoingOut := GoingOut + 00 + 0;
'O','o': GoingOut := GoingOut + 00 + 8;
'n' : GoingOut := GoingOut + 16 + 0;
'E','e': GoingOut := GoingOut + 16 + 8;
end;
Case StopBits of
1: GoingOut := GoingOut + 0;
2: GoingOut := GoingOut + 4;
end;
BlankRegisters;
With RegistersRecord do
begin
AH := 0;
AL := GoingOut;
DX := (Port);
Intr($14, RegistersRecord);
end;
end;
procedure InitializeDriver; { Do this before doing }
begin { any IO routines!!! }
BlankRegisters;
With RegistersRecord do
begin
AH := 4;
DX := (Port);
Intr($14, RegistersRecord);
If AX <> $1954 then
begin
Writeln('* FOSSIL DRIVER NOT RESPONDING! OPERATION HALTED!');
halt(1);
end;
end;
end;
procedure CloseDriver; { Run this after all I/O routines are done with }
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 5;
DX := (Port);
Intr($14, RegistersRecord);
end;
BlankRegisters;
end;
procedure ReadKeyAhead (var First, Second: Char); { This procedure is via }
{ the FOSSIL driver, not }
{ DOS! }
begin
BlankRegisters;
With RegistersRecord do
begin
AH := $0D;
Intr($14,RegistersRecord);
First := chr(lo(AX));
Second := chr(hi(AX));
end;
end;
function ReceiveAhead (var Character: CHAR): Boolean; { Non-destructive }
begin
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := $0C;
DX := Port;
Intr ($14,RegistersRecord);
Character := CHR (AL);
ReceiveAhead := AX <> $FFFF;
end;
end;
function OnLine: Boolean;
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 3;
DX := (Port);
Intr ($14, RegistersRecord);
OnLine := ((AL AND 128) = 128);
end;
end;
procedure DTR (DTRState: Integer); { 1=ON, 0=OFF }
{ Be sure that the modem dip switches }
{ are set properly... when DTR is off }
{ it usually drops carrier if online }
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 6;
DX := (Port);
AL := DTRState;
Intr ($14, RegistersRecord);
end;
end;
procedure Reboot; { For EXTREME emergencies... Hmmm... }
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 23;
AL := 1;
Intr ($14, RegistersRecord);
end;
end;
{ This is ANSI Screen Write via Fossil Driver }
{
procedure ANSIScreenWrite (Character: CHAR);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 19;
(100 min left), (H)elp, More? AL := ORD (Character);
Intr ($14, RegistersRecord);
end;
end;
}
{ This is ANSI Screen Write via DOS! }
procedure ANSIScreenWrite (Character: CHAR);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 2;
DL := ORD (Character);
Intr ($21, RegistersRecord);
end;
end;
procedure BIOSScreenWrite (Character: CHAR); { Through the FOSSIL driver }
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 21;
AL := ORD (Character);
Intr ($14, RegistersRecord);
end;
end;
procedure WatchDog (INPUT: Boolean);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 20;
DX := Port;
Case INPUT of
TRUE: AL := 1;
FALSE: AL := 0;
end;
Intr ($14, RegistersRecord);
end;
end;
procedure WhereCursor (var Row: Integer; var Column: Integer);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 18;
Intr ($14, RegistersRecord);
Row := DH;
Column := DL;
end;
end;
procedure MoveCursor (Row: Integer; Column: Integer);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 17;
DH := Row;
DL := Column;
Intr ($14, RegistersRecord);
end;
end;
procedure KillInputBuffer; { Kills all remaining input that has not been }
{ read in yet }
begin
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := 10;
DX := Port;
Intr ($14, RegistersRecord);
end;
end;
procedure KillOutputBuffer; { Kills all pending output that has not been }
{ send yet }
begin
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := 9;
DX := Port;
Intr ($14, RegistersRecord);
end;
end;
procedure FlushOutput; { Flushes the output buffer }
begin
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := 8;
DX := Port;
Intr ($14, RegistersRecord);
end;
end;
function InputAvailable: Boolean; { Returns true if there's input }
{ from the modem. }
begin
InputAvailable := False;
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := 3;
DX := Port;
Intr ($14, RegistersRecord);
InputAvailable := ((AH AND 1) = 1);
end;
end;
function OutputOkay: Boolean; { Returns true if output buffer isn't full }
begin
OutputOkay := True;
If Baud=0 then exit;
BlankRegisters;
With RegistersRecord do
begin
AH := 3;
DX := Port;
Intr ($14, RegistersRecord);
OutputOkay := ((AH AND 32) = 32);
end;
end;
procedure ReceiveCharacter (var Character: CHAR); { Takes a character }
{ out of the input }
{ buffer }
begin
Character := #0;
BlankRegisters;
With RegistersRecord do
begin
AH := 2;
DX := Port;
Intr ($14, RegistersRecord);
Character := CHR (AL);
end;
end;
procedure TransmitCharacter (Character: CHAR; var Status: Integer);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 1;
DX := Port;
AL := ORD (Character);
Intr ($14, RegistersRecord);
Status := AX; { Refer to FOSSIL.DOC about the STATUS var }
end;
end;
procedure FlowControl (Control: Boolean);
begin
BlankRegisters;
With RegistersRecord do
begin
AH := 15;
DX := Port;
Case Control of
TRUE: AL := 255;
FALSE: AL := 0;
end;
Intr ($14, RegistersRecord);
end;
end;
procedure CharacterOut (Character: CHAR);
var
Status: INTEGER;
begin
{ If SNOOP is on then }
ANSIScreenWrite (Character);
TransmitCharacter (Character, Status);
end;
procedure StringOut (Message: String255);
var
CharPos: Byte;
begin
CharPos := 0;
If Length(Message) <> 0 then
begin
Repeat
If NOT Online then exit;
CharPos := CharPos + 1;
CharacterOut (Message [CharPos]);
Until CharPos = Length (Message);
end;
end;
procedure LineOut (Message: String255);
begin
StringOut (Message);
CharacterOut (#13);
CharacterOut (#10);
end;
procedure CrOut; { Outputs a carriage return and a line feed }
begin
CharacterOut (#13);
CharacterOut (#10);
end;
end.
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]