[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
Unit Modem;
{$O+,F+}
InterFace
uses dos;
const crlf:string[2] = #13+#10;
type
pDriverInfo = ^DriverInfo;
DriverInfo = record
Size : Word;
Spec : byte;
Rev : Byte;
ID : String;
Ibuf : Word;
Iavl : Word;
OBuf : Word;
Oavl : Word;
Width : Byte;
Height: Byte;
Baud : Byte;
end;
Type
pModemObj = ^ModemObj;
ModemObj = object
Function Init(c:byte):boolean;
Procedure Close;
Function Spec:byte;
Function Rev :byte;
Function ID :String;
Function InputBuf : word;
Function OutputBuf: word;
Function DTEBaud: word;
Function OutBufUsed: word;
Function InBufUsed: word;
Procedure SetParams(baud_:word; DataBits:byte; Parity:char; StopBit:byte);
Procedure SetDtr(state:boolean);
Procedure SetFlow(state:boolean);
Function CD:boolean;
Procedure KillOut;
Procedure KillIn;
Procedure Flush;
Function Available:boolean;
Function OkToSend:boolean;
Function Empty:boolean;
Procedure WriteChar(c:char);
Procedure Write(s:string);
Procedure Writeln(s:string);
Function Readkey:char;
Function HangUp:boolean;
Function ATCommand(command:string):boolean;
Function PeekAhead:char;
Procedure Snarf(n:word);
Procedure ReadBlock(var s:string;reqnum,maxnum:byte);
Private
ComPortVal: byte;
DriverInfo: pDriverInfo;
Procedure SetComPort(c:byte);
Function ComPort:byte;
Procedure GetInfo;
end;
IMPLEMENTATION
uses Crt; { needed for Delay() }
Procedure ModemObj.GetInfo;
type
DvrInfo = Record
Size : Word;
Spec : byte;
Rev : Byte;
ID : Pointer;
Ibuf : Word;
Iavl : Word;
OBuf : Word;
Oavl : Word;
Width : Byte;
Height: Byte;
Baud : Byte;
End;
var regs:registers;
di: dvrinfo;
ts: string;
Begin
fillchar(regs,sizeof(regs),0);
Regs.Cx := Sizeof(di);
Regs.Es := Seg(di);
Regs.Di := Ofs(di);
Regs.Dx := comport-1;
Regs.ah := $1B;
Intr($14,Regs);
DriverInfo^.Size := di.size;
DriverInfo^.spec := di.spec;
DriverInfo^.rev := di.rev;
DriverInfo^.ibuf := di.ibuf;
DriverInfo^.iavl := di.iavl;
DriverInfo^.obuf := di.obuf;
DriverInfo^.oavl := di.oavl;
DriverInfo^.width := di.width;
DriverInfo^.height := di.height;
DriverInfo^.baud := di.baud;
move ( di.id^, mem[seg(ts):ofs(ts)+1], sizeof(ts)-1);
ts[0]:=#255;
ts[0]:=char(pos(#0,ts)-1);
DriverInfo^.id:=ts;
End;
Function ModemObj.Spec:byte;
begin
Spec := DriverInfo^.Spec;
end;
Function ModemObj.Rev :byte;
begin
Rev:=DriverInfo^.Rev;
end;
Function ModemObj.ID :String;
begin
ID:=DriverInfo^.id;
end;
Function ModemObj.InputBuf : word;
begin
InputBuf := DriverInfo^.IBuf;
end;
Function ModemObj.OutputBuf: word;
begin
OutputBuf := DriverInfo^.OBuf;
end;
{
010 = 300 baud
011 = 600 ''
100 = 1200 ''
101 = 2400 ''
110 = 4800 ''
111 = 9600 ''
000 = 19200 '' (Replaces old 110 baud mask)
001 = 38400 '' (Replaces old 150 baud mask)
}
Function ModemObj.DTEBaud: word;
begin
case driverinfo^.baud of
0: dtebaud := 19200;
1: dtebaud := 38400;
2: dtebaud := 300;
3: dtebaud := 600;
4: dtebaud := 1200;
5: dtebaud := 2400;
6: dtebaud := 4800;
7: dtebaud := 9600;
else dtebaud := 0;
end;
end;
Function ModemObj.OutBufUsed:word;
begin
GetInfo;
OutBufUsed := DriverInfo^.OAvl;
end;
Function ModemObj.InBufUsed:word;
begin
GetInfo;
InBufUsed := DriverInfo^.IAvl;
end;
function ModemObj.PeekAhead:char;
var regs:registers;
begin
fillchar(regs,sizeof(regs),0);
with regs do
begin
ah:=$0C;
dx:=comport-1;
end;
Intr($14, regs);
if regs.ax=$ffff then PeekAhead:=#0 else
PeekAhead:=char(regs.al);
end;
Procedure ModemObj.SetComPort(c:byte);
begin
ComPortVal:=c;
end;
Function ModemObj.ComPort:byte;
begin;
ComPort:=ComPortVal;
end;
Function ModemObj.Init(c: Byte):boolean;
var regs:registers;
Begin
ModemObj.SetComPort(c);
FillChar(regs,sizeof(regs),0);
With Regs Do
Begin
AH := 4;
DX := (ComPort-1);
end;
Intr($14, Regs);
if (regs.AX=$1954) then
begin
Init:=True;
New(DriverInfo);
GetInfo;
end
else Init:=False;
end;
Procedure ModemObj.Close;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
{a setdtr(false) used to be here}
With Regs Do
Begin
AH := 5;
DX := (ComPort-1);
Intr($14, Regs);
end;
dispose(Driverinfo);
end;
{
| AH = 18h Read block (transfer from FOSSIL to user buffer)
| Parameters:
| Entry: CX = Maximum number of characters to transfer
| DX = Port number
| ES = Segment of user buffer
| DI = Offset into ES of user buffer
| Exit: AX = Number of characters actually transferred
| A "no-wait" block read of 0 to FFFFh characters from the FOSSIL inbound
| ring buffer to the calling routine's buffer. ES:DI are left unchanged by
| the call; the count of bytes actually transferred will be returned in AX.
}
Procedure ModemObj.ReadBlock(var s:string;reqnum,maxnum:byte);
var regs:registers;
t:string;
begin
with regs do
begin
if maxnum<=255 then cx := maxnum else cx := 255;
dx := comport-1;
es := seg(s);
di := ofs(s) +1;
end;
Intr($14, regs);
s[0] := chr(regs.ax);
if regs.ax<reqnum then
begin
t:='';
ReadBlock(t,reqnum-regs.ax,maxnum-regs.ax);
s:= concat (s,t);
end;
end;
Procedure ModemObj.SetParams (Baud_: Word; DataBits: Byte; Parity: Char;
StopBit: Byte);
Var
Code: Integer;
regs:registers;
Begin
Code:=0;
FillChar(regs,sizeof(regs),0);
Case Baud_ of
0 : Exit;
19200 : code:=code+000+00+00;
38400 : code:=code+000+00+32;
300 : code:=code+000+64+00;
600 : code:=code+000+64+32;
1200: code:=code+128+00+00;
2400: code:=code+128+00+32;
4800: code:=code+128+64+00;
9600: code:=code+128+64+32;
end;
Case DataBits of
5: code:=code+0+0;
6: code:=code+0+1;
7: code:=code+2+0;
8: code:=code+2+1;
end;
Case Parity of
'N','n': code:=code+00+0;
'O','o': code:=code+00+8;
'E','e': code:=code+16+8;
end;
Case StopBit of
1: code := code + 0;
2: code := code + 4;
end;
With Regs do
begin
AH := 0;
AL := Code;
DX := (ComPort-1);
Intr($14, Regs);
end;
end;
Procedure ModemObj.SetDtr (State: Boolean);
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
begin
AH := 6;
DX := (ComPort-1);
Case State of
True : AL := 1;
False: AL := 0;
end;
Intr($14, Regs);
end;
end;
Function ModemObj.CD : Boolean;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 3;
DX := (ComPort-1);
Intr($14, Regs);
CD := ((AL AND 128) = 128);
end;
end;
Procedure ModemObj.SetFlow (State: Boolean);
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 15;
DX := ComPort-1;
Case State of
TRUE: AL := 255;
FALSE: AL := 0;
end;
Intr($14, Regs);
end;
end;
Procedure ModemObj.KillOut;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
begin
AH := 9;
DX := ComPort-1;
Intr($14, Regs);
end;
end;
Procedure ModemObj.Snarf(n:word);
var c:char;
i:word;
begin
for i:=1 to n do c:=readkey;
end;
Procedure ModemObj.KillIn ;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
begin
AH := 10;
DX := ComPort-1;
Intr($14, Regs);
end;
end;
Procedure ModemObj.Flush ;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 8;
DX := ComPort-1;
Intr($14, Regs);
end;
end;
Function ModemObj.Available: Boolean;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 3;
DX := ComPort-1;
Intr($14, Regs);
Available:= ((AH AND 1) = 1);
end;
end;
Function ModemObj.OkToSend : Boolean;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 3;
DX := ComPort-1;
Intr($14, Regs);
OkToSend := ((AH AND 32) = 32);
end;
end;
Function ModemObj.Empty : Boolean;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 3;
DX := ComPort-1;
Intr($14, Regs);
Empty := ((AH AND 64) = 64);
end;
end;
Procedure ModemObj.WriteChar (C: Char);
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 1;
DX := ComPort-1;
AL := ORD (C);
Intr($14, Regs);
end;
end;
{
| AH = 19h Write block (transfer from user buffer to FOSSIL)
| Parameters:
| Entry: CX = Maximum number of characters to transfer
| DX = Port number
| ES = Segment of user buffer
| DI = Offset into ES of user buffer
| Exit: AX = Number of characters actually transferred
| A "no-wait" block move of 0 to FFFFh characters from the calling
| program's buffer into the FOSSIL outbound ring buffer. ES:DI are left
| unchanged by the call; the count of bytes actually transferred will be
| returned in AX.
}
Procedure ModemObj.Write ( s: String);
Var
regs:registers;
begin
FillChar(regs,sizeof(regs),0);
with regs do
begin
ah := $19;
cx := ord(s[0]);
dx := comport-1;
es := seg(s);
di := ofs(s)+1;
Intr($14, regs);
end;
if not(regs.ax=ord(s[0])) then
begin
Flush;
Write(copy(s,regs.ax+1,ord(s[0])));
end;
end;
Procedure ModemObj.Writeln (s: String);
Var
regs:registers;
begin
Write(s+crlf);
end;
Function ModemObj.Readkey : Char;
var regs:registers;
Begin
FillChar(regs,sizeof(regs),0);
With Regs do
Begin
AH := 2;
DX := ComPort-1;
Intr($14, Regs);
Readkey := Chr(AL);
end;
end;
Function ModemObj.Hangup : Boolean;
var
Tcount : Integer;
var regs:registers;
begin
ModemObj.SetDtr(FALSE);
delay (600);
ModemObj.SetDtr(TRUE);
if ModemObj.CD=true then begin
Tcount:=1;
repeat
ModemObj.Write ('+++');
delay (3000);
ModemObj.Writeln ('ATH0');
delay(3000);
if ModemObj.CD=false then tcount:=3;
Tcount:=Tcount+1;
until Tcount=4;
end;
hangup:=not(ModemObj.cd=true)
end;
Function ModemObj.AtCommand (Command: String) : Boolean;
Var
Ch : Char;
Result : String[50];
I,Z : Integer;
Begin
AtCommand:=FALSE;
Result:='';
For Z:=1 to 3 do begin
Write (Char(13));
Writeln (Command);
Delay(500);
Repeat
If Available then Begin
Ch:=Readkey;
Result:=Result+Ch;
end;
Until Available=FALSE;
For I:=1 to Length(Result)-2 do Begin
If copy(result,i,2)='OK' then Begin
AtCommand:=TRUE;
Exit;
end;
end;
end;
End;
END.
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]