[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
UNIT FossilP; { see demo at end of code }
INTERFACE
Uses Dos, Crt; { Phone, PXEngine, PxMsg; Config;}
Type
FossilInfo = Record
MaxFunc :Byte; {Max func number supported}
Revision :Byte; {Fossil revision supported}
MajVer :Byte; {Major version}
MinVer :Byte; {Minor version}
Ident :PChar; {Null terminated ID string}
IBufr :Word; {size of input buffer}
IFree :Word; {number of bytes left in buffer}
OBufr :Word; {size of output buffer}
OFree :Word; {number of bytes left in buffer}
SWidth :Byte; {width of screen}
SHeight :Byte; {height of screen}
Baud :Byte; {ACTUAL baud rate, computer to modem}
End;
FossilInfo2 = Record
StrucSize :Word; {Structure size in bytes}
MajVer :Byte; {Major version}
MinVer :Byte; {Minor version}
Ident :PChar; {Null terminated ID string}
IBufr :Word; {size of input buffer}
IFree :Word; {number of bytes left in buffer}
OBufr :Word; {size of output buffer}
OFree :Word; {number of bytes left in buffer}
SWidth :Byte; {width of screen}
SHeight :Byte; {height of screen}
Baud :Byte; {ACTUAL baud rate, computer to modem}
End;
Procedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);
Function FReadKey:Word;
Procedure FossilInt(var R:Registers);
Procedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);
Procedure InitFossil(var FosInf:FossilInfo; Port:Word);
Procedure DeInitFossil(Port:Word);
Function FIsKeyPressed:Word;
Function FossilReadChar(Port:Word):Byte;
Function FossilIsCharReady(Port:Word):Word;
Function FossilSendChar(Port:Word; Char:byte):Word;
Procedure Init;
Procedure FossilSendStr(S:String; Port:Word);
Procedure DialNo(Port:Word);
Procedure Run;
Procedure Done;
Procedure WriteAnsi;
Procedure HangUp;
Procedure DialRec(Port:Word);
IMPLEMENTATION
{ Fossil Functions }
Procedure FossilInt(var R:Registers);
begin
Intr($14,R);
End;
Procedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);
Var Out : Integer;
R : Registers;
Port: Word;
Begin
Out := 0;
Case Baud Of
0 :Exit;
100 :Out := Out + 000 + 00 + 00;
150 :Out := Out + 000 + 00 + 32;
300 :Out := Out + 000 + 64 + 00;
1200 :Out := Out + 128 + 00 + 00;
2400 :Out := Out + 128 + 00 + 32;
4800 :Out := Out + 128 + 64 + 00;
9600 :Out := Out + 128 + 64 + 32;
End;
Case DataBit Of
5 :Out := Out + 0 + 0;
6 :Out := Out + 0 + 1;
7 :Out := Out + 2 + 0;
8 :Out := Out + 2 + 1;
End;
Case Party Of
'N' :Out := Out + 00 + 0;
'O', 'o' :Out := Out + 00 + 8;
'n' :Out := Out + 16 + 0;
'E', 'e' :Out := Out + 16 + 8;
End;
Case StopBit Of
1 :Out := Out + 0;
2 :Out := Out + 4;
End;
R.AH:=0;
R.AL:=Out;
R.DX:=Port;
FossilInt(R);
End;
Procedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);
Var
R: Registers;
Begin
R.AH:=$1B; {Function number 1bh}
R.CX:=SizeOf(FosRec); {size of user info}
R.DX:=Port; {port number}
R.ES:=Seg(FosRec); {segment of info buf}
R.DI:=Ofs(FosRec); {offset of info buf}
FossilInt(R);
End;
Procedure InitFossil(var FosInf:FossilInfo; Port:Word);
Var
R :Registers;
Z :FossilInfo2;
Begin
R.AH:=$04;
R.DX:=Port;
FossilInt(R);
if R.AX=$1954 then begin {AX should countain 1954h if fossil is loaded}
FosInf.MaxFunc :=R.BL;
FosInf.Revision:=R.BH;
GetFossilInfo(Z,Port);
with FosInf do begin
MajVer:= Z.MajVer;
MinVer:= Z.MinVer;
Ident := Z.Ident;
IBufr := Z.IBufr;
IFree := Z.IFree;
OBufr := Z.OBufr;
OFree := Z.OFree;
SWidth:= Z.SWidth;
SHeight:=Z.SHeight;
Baud := Z.Baud;
End;
End Else FosInf.MaxFunc:=0; {MaxFunc contains 0 if fossil is not found}
End;
Procedure DeInitFossil(Port:Word);
var
R: Registers;
Begin
R.AH:=$05;
R.DX:=Port;
FossilInt(R);
End;
Function FIsKeyPressed:Word;
var
R:Registers;
Begin
R.AH:=$0D;
FossilInt(R);
FIsKeyPressed := R.AX;
End;
Function FReadKey:Word;
var
R:Registers;
Begin
R.AH:=$0E;
FossilInt(R);
FReadKey := R.AX;
End;
Function FossilReadChar(Port:Word):Byte;
var
R :Registers;
Begin
R.AH:=$02;
R.DX:=Port;
FossilInt(R);
FossilReadChar := R.AL
End;
Function FossilIsCharReady(Port:Word):Word;
var
R :Registers;
Begin
R.AH:=$0C;
R.DX:=Port;
FossilInt(R);
FossilIsCharReady := R.AX;
End;
Function FossilSendChar(Port:Word; Char:byte):Word;
var
R :Registers;
Begin
R.AH:=$01;
R.DX:=Port;
R.AL:=Char;
FossilInt(R);
FossilSendChar := R.AX;
End;
Const
CurPort :Word = 1; {current COM port of modem}
ExitKey=$2d00; {ALT-X}
DialKey=$2000; {ALT-D}
DialPref:String ='ATDT';
DialSuf :String =#13;
Var
Z :FossilInfo;
Procedure Init;
Begin
Write('Modem Port(0=COM1):');
ReadLn(CurPort);
InitFossil(Z,CurPort);
if Z.MaxFunc=0 then begin
WriteLn('ERROR:No FOSSIL driver found!');
Sound(400);
Delay(500);
NoSound;
Halt(1);
End;
WriteLn('Fossil: Rev ',Z.Revision,' ',Z.Ident);
End;
Procedure FossilSendStr(S:String; Port:Word);
Var
I:Byte;
Begin
for I:=1 to byte(S[0]) do FossilSendChar(Port,byte(S[I]));
End;
Procedure DialNo(Port:Word);
Const SufixDial = 'ATDT';
var
TelNo:String;
Begin
WriteLn;
Write('Number to dial:');
ReadLn(TelNo);
if TelNo<>'' then begin
TelNo := SufixDial+TelNo+DialSuf;
FossilSendStr(TelNo,Port);
end;
end;
Procedure DialRec(Port:Word);
var
SufixDial : String;
Num : Integer;
BBSName : String;
BBSNumber : String;
Password : String;
Speed : Integer;
TelNo : String;
Begin
Writeln('TelNo is ',TelNo);
TelNo := 'ATDT'+TelNo+DialSuf;
FossilSendStr(TelNo,Port);
End;
Procedure Run;
var
Key :Word;
Done:Boolean;
Begin
Done := False;
Repeat
If FossilIsCharReady(1)<>$FFFF Then Begin
Write(Chr(FossilReadChar(CurPort)));
End;
If FIsKeyPressed<>$FFFF Then Begin
Key:=FReadKey;
Case Key Of
ExitKey:Done:=True;
DialKey:DialNo(CurPort);
Else FossilSendChar(CurPort,Lo(Key));
End;
End;
Until Done;
End;
Procedure WriteAnsi;
Var R : registers;
Begin
R.AH := $13;
R.AL := ORD(FossilreadChar(CurPort));
Intr($14, R);
End;
Procedure HangUp;
Begin
FossilSendSTR('+++',CurPort);
FossilSendSTR('ATH0'+#13, CurPort);
End;
Procedure Done;
Begin
DeInitFossil(CurPort);
End;
End.
{ -------------------------------- DEMO PROGRAM --------------------- }
{$M 65520,65520,65520}
Program AnsiEmu;
Uses Dos, Crt, FossilP;
Const CurPort :Word=1;
ExitKey = $2d00; {ALT-X}
DialKey = $2000; {ALT-D}
HangUpKey = $2300; {ALT-H}
DownLoadKey = $2004; {CTRL+D}
UpLoadKey = $1615; {CTRL+U}
ChangeSetUp = $2100; {ALT+F}
Menuu = $2E00; {ALT+C}
PgUp = $4900; {PageUp}
PgDown = $5100; {PageDown}
ReadPhon = $1900; {ALT+P}
DialPref :String='ATDT';
DialSuf :String=#13;
Var Key : Word;
Done : Boolean;
AnsiM : Char;
{ZMODEM'iga download}
Procedure DownLoadZ;
Begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');
SwapVectors;
End;
Procedure UpLoadZ;
Var FileName : String;
Begin
Write('Millist faili tahad Uppida: ');
Readln(FileName);
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);
SwapVectors;
End;
Procedure FirstKey;
Var Vastus : Byte;
Begin
ClrScr;
TextColor(red);
Writeln('Millist Protocolli kasutad: ');
Writeln;
Writeln('1. Zmodem');
Writeln('2. Puma ');
Writeln('3. SeaLink');
Writeln;
Write('Vastus: ');
Readln(Vastus);
Case Vastus of
1 : DownLoadZ;
End; {End Case}
TextColor(White);
End;
Procedure DownLoad;
Begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');
SwapVectors;
End;
Procedure UpLoad;
Var FileName : String;
Begin
Write('Enter Filename to UpLoad: ');
Readln(FileName);
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);
SwapVectors;
End;
Begin
ClrScr;
TextColor(White);
Init;
Done:=False;
Repeat
If FossilIsCharReady(1)<>$FFFF then begin
{Write(Chr(FossilReadChar(CurPort)));}
WriteAnsi; {If ANSI loaded then color else BW}
End;
if FIsKeyPressed<>$FFFF then begin
Key:=FReadKey;
case Key of
ExitKey : Done:=True;
DialKey : DialNo(CurPort);
HangUpKey : HangUp;
DownLoadKey: DownLoadZ;
UpLoadKey : UpLoadZ;
PgDown : FirstKey; {DownLoadSeaLink;}
PgUp : UpLoad;
Else FossilSendChar(CurPort, Lo(Key));
End;
End;
Until Done;
Writeln('The End :-)');
{PXDone;}
TextColor(White);
End.
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]