home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / comm.swg / 0048_Full Fossil Code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  12.7 KB  |  460 lines
  1.  
  2. (*    ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  3.       █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█
  4.       █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█
  5.       █░░░░░░░█████████████████████████████████████████████░░░░░░░░░░░░░█
  6.       █░░░░░░░██                                         ██ ░░░░░░░░░░░░█
  7.       █░░░░░░░██ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░██ ░░░░░░░░░░░░█
  8.       █░░░░░░░██ ░░░░░░░██████░░░░███████░░░███████░░██░░██ ░░░░░░░░░░░░█
  9.       █░░░░░░░███████░░█      █░░░█       ░░█       ░██ ░██ ░░░░░░░░░░░░█
  10.       █░░░░░░░██      ░█ ░░░░░█ ░░███████ ░░███████ ░██ ░██ ░░░░░░░░░░░░█
  11.       █░░░░░░░██ ░░░░░░█ ░░░░░█ ░░░     █ ░░░     █ ░██ ░██ ░░░░░░░░░░░░█
  12.       █░░░░░░░██ ░░░░░░░██████  ░░███████ ░░███████ ░██ ░████████░░░░░░░█
  13.       █░░░░░░░░  ░░░░░░░░      ░░░░       ░░░       ░░  ░         ░░░░░░█
  14.       █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█
  15.       █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█
  16.       ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  17.    ■  FIDO/OPUS/SEADOG/Standard Interface Layer  ■           Version 1.02
  18.  
  19.       Interface for X00 and BNU Fossil Driver(s)
  20.  
  21.       Written by: Mike Whitaker  *)
  22.  
  23. {$R-,S-,I-,D-,F+,V-,B-,N-}
  24.  
  25. Unit Fossil;
  26.  
  27. Interface
  28.  
  29. Uses Dos, Crt;
  30.  
  31. Const  CTS_RTS  = 2;    { To Control Flow Control }
  32.        XON_XOFF = 9;
  33.  
  34. Type Fossil_Struct = Record
  35.        StructSize : Word;
  36.        MajorVer   : Byte;
  37.        MinVer     : Byte;
  38.        FOS_ID     : Array [1..2] of Word;
  39.        Inp_Buffer : Word;
  40.        Recv_Bytes : Word;
  41.        Out_Buffer : Word;
  42.        Send_Bytes : Word;
  43.        SWidth     : Byte;
  44.        SHeight    : Byte;
  45.        BaudRate   : Byte
  46.      End;
  47.  
  48. Var FosPort  : Byte;
  49.  
  50.  
  51. Function  Install_Fossil (ComPort:Byte):Boolean;
  52. Procedure Close_Fossil (ComPort:Byte);
  53. Procedure Set_Fossil (ComPort:Byte; BaudRate:LongInt; DataBits:Byte;
  54.                      Parity:Char; StopBits:Byte);
  55. Procedure SendChar (K:Char);
  56. Procedure SendString (S:String);
  57. Function  GetChar:Char;
  58. Function  Fossil_Chars:Boolean;
  59. Function  Fossil_Carrier:Boolean;
  60. Procedure Fossil_DTR (ComPort:Byte; State:Boolean);
  61. Procedure Hangup;
  62. Procedure Fossil_Timer (Var Tick_Int, Ints_Sec:Byte; MS_Tics:Integer);
  63. Procedure Fossil_OutPut_FLUSH (ComPort:Byte);
  64. Procedure Fossil_Nuke_Input   (ComPort:Byte);
  65. Procedure Fossil_Nuke_OutPut  (ComPort:Byte);
  66. Function  NoWait_Send (K:Char):Boolean;
  67. Function  Fossil_Peek:Char;
  68. {Function  Fossil_GetChar:Char;}
  69. Function  Fossil_Wait:Char;
  70. Procedure Fossil_FLOW (State:Byte);
  71. Procedure Set_CtrlC (ComPort, State:Byte);
  72. Function  CtrlC_Check (ComPort:Byte):Boolean;
  73. Procedure Fossil_GotoXY (X,Y:Byte);
  74. Procedure Fossil_Position (Var X,Y:Byte);
  75. Function  Fossil_WhereX:Byte;
  76. Function  Fossil_WhereY:Byte;
  77. Procedure ANSI_Write (K:Char);
  78. Procedure WatchDog (Status:Boolean);
  79. Procedure BIOS_Write (K:Char);
  80. Function  Add_Fossil_Proc    (Var P):Boolean;
  81. Function  Delete_Fossil_Proc (Var P):Boolean;
  82. Procedure WarmBoot;
  83. Procedure ColdBoot;
  84. Function  Fossil_BlockRead  (Bytes:Word; Var Buffer):Integer;
  85. Function  Fossil_BlockWrite (Bytes:Word; Var Buffer):Integer;
  86. Function  Fossil_Descrip (ComPort:Byte):String;
  87. Function  Fos_Ringing: Boolean;
  88. Implementation
  89.  
  90.  
  91.  
  92. Var R:Registers;
  93.  
  94. Procedure Delay (I:Integer);
  95. Begin
  96.   R.Ah := $86;
  97.   Move (I,R.Cx,2);
  98.   Intr ($15,R)
  99. End;
  100.  
  101. Function Install_Fossil (ComPort:Byte):Boolean;
  102. Begin                                   { Initializes the Specified  }
  103.   R.Ah := $04;                          { Communications Port        }
  104.   R.Dx := ComPort - 1;                  { Sets FOSPORT to COMPORT    }
  105.   R.Bx := $4F50;
  106.   Intr ($14,R);
  107.   Install_Fossil := R.Ax = $1954;
  108.   FosPort := ComPort - 1
  109. End;
  110.  
  111. Procedure Close_Fossil (ComPort:Byte);  { Closes the Initialized     }
  112. Begin                                   { Communications Port        }
  113.   R.Ah := $05;
  114.   R.Dx := ComPort - 1;
  115.   Intr ($14,R);
  116.   FosPort := 255
  117. End;
  118.  
  119.  
  120. Procedure Set_Fossil (ComPort:Byte; BaudRate:LongInt; DataBits:Byte;
  121.                       Parity:Char; StopBits:Byte);
  122. Var Baud,Code:Byte;                     { Sets the to the COMPORT    }
  123. Begin                                   { The BaudRate, DataBits,    }
  124.   Case BaudRate of                      { The Parity, And StopBits   }
  125.    1200  : Baud := 128;                 { Sets FOSPORT to COMPORT    }
  126.    2400  : Baud := 160;
  127.    4800  : Baud := 192;
  128.    9600  : Baud := 224;
  129.    19200 : Baud := 0
  130.    Else If BaudRate = 38400 Then Baud := 32
  131.   End;
  132.   Case DataBits of
  133.  { 5 : Baud := Baud + 0; }
  134.    6 : Baud := Baud + 1;
  135.    7 : Baud := Baud + 2;
  136.    8 : Baud := Baud + 3
  137.   End;
  138.   Case Parity of
  139.  { 'N' : Baud := Baud + 0; }
  140.    'O' : Baud := Baud + 8;
  141.    'E' : Baud := Baud + 24
  142.   End;
  143.   Case StopBits of
  144.    1 : Baud := Baud + 0;
  145.    2 : Baud := Baud + 4
  146.   End;
  147.   R.Ah := 0;
  148.   R.Al := Baud;
  149.   R.Dx := ComPort - 1;
  150.   Intr ($14,R);
  151.   FosPort := ComPort - 1
  152. End;
  153.  
  154. Function Fos_Ringing: Boolean;
  155. var
  156.   CC : Char;
  157. begin
  158.   Fos_Ringing := False;
  159.   R.Ah := $0C;
  160.   R.Dx := fosport;
  161.   Intr($14, R);
  162.   if r.ax = $FFFF then
  163.     Fos_ringing := false
  164.   else
  165.   begin
  166.     cc := chr(r.al);
  167.     if cc = #13 then
  168.       Fos_ringing := true;
  169.   end;
  170. end;
  171.  
  172.  
  173.  
  174. Procedure SendChar (K:Char);            { Transmitts a Character     }
  175. Begin                                   { through FOSPORT Comm Port  }
  176.   R.Ah := $01;                          { and then Waits.            }
  177.   R.Al := Ord(K);
  178.   R.Dx := FosPort;
  179.   Intr ($14,R)
  180. End;
  181.  
  182.  
  183. Procedure SendString (S:String);        { Sends a String through the }
  184. Var I:Integer;
  185. Begin
  186.   I:=Fossil_BlockWrite (Length(S),S)
  187. End;
  188.  
  189.  
  190. Function GetChar:Char;                  { Gets a Character from the  }
  191. Begin                                   { FOSPORT Communications Port}
  192.   R.Ah := $02;
  193.   R.Dx := FosPort;
  194.   Intr ($14,R);
  195.   GetChar := Chr(R.Al)
  196. End;
  197.  
  198. Function Fossil_Chars:Boolean;
  199. Begin
  200.   R.Ah := $03;
  201.   R.Dx := FosPort;
  202.   Intr ($14,R);
  203.   Fossil_Chars := (R.Ah And 1) = 1
  204. End;
  205.  
  206. Function Fossil_Carrier:Boolean;        { Detects whether a Carrier  }
  207. Begin                                   { is on FOSPORT Port         }
  208.   R.Ah := $03;
  209.   R.Dx := FosPort;
  210.   Intr ($14,R);
  211.   Fossil_Carrier := (R.Al And 128) = 128
  212. End;
  213.  
  214. Procedure Fossil_DTR (ComPort:Byte; State:Boolean);
  215. Begin                                   { Lowers/Raises the DTR on   }
  216.   R.Ah := $06;                          { COMPORT                    }
  217.   R.Al := Byte(State);
  218.   R.Dx := ComPort - 1;
  219.   Intr ($14,R)
  220. End;
  221.  
  222.  
  223. Procedure Hangup;
  224. Begin
  225.   If Not Fossil_Carrier Then Exit;
  226.   Fossil_DTR (FosPort + 1,False);
  227.   Delay (700);
  228.   Fossil_DTR (FosPort + 1,True);
  229.   If Fossil_Carrier Then SendString ('+++')
  230. End;
  231.  
  232. Procedure Fossil_Timer (Var Tick_Int, Ints_Sec:Byte; MS_Tics:Integer);
  233. Begin
  234.   R.Ah := $07;
  235.   Intr ($14,R);
  236.   Tick_Int := R.Al;
  237.   Ints_Sec := R.Ah;
  238.   MS_Tics  := R.Dx
  239. End;
  240.  
  241.  
  242. Procedure Fossil_OutPut_FLUSH (ComPort:Byte);
  243. Begin                                   { Forecs the OutPut Chars    }
  244.   R.Ah := $08;                          { out of the Buffer          }
  245.   R.Dx := ComPort - 1;
  246.   Intr ($14,R)
  247. End;
  248.  
  249. Procedure Fossil_Nuke_OutPut (ComPort:Byte);
  250. Begin                                   { Purges the OutPut Buffer   }
  251.   R.Ah := $09;
  252.   R.Dx := ComPort - 1;
  253.   Intr ($14,R)
  254. End;
  255.  
  256. Procedure Fossil_Nuke_Input (ComPort:Byte);
  257. Begin                                   { Purges the Input Buffer    }
  258.   R.Ah := $0A;
  259.   R.Dx := ComPort - 1;
  260.   Intr ($14,R)
  261. End;
  262.  
  263. Function NoWait_Send (K:Char):Boolean;
  264. Begin
  265.   R.Ah := $0B;
  266.   R.Al := Ord(K);
  267.   R.Dx := FosPort;
  268.   Intr ($14,R);
  269.   NoWait_Send := Boolean(R.Ax)
  270. End;
  271.  
  272. Function Fossil_Peek:Char;              { Checks out what the Next   }
  273. Begin                                   { Character is in FOSPORT    }
  274.   R.Ah := $0C;                          { Without Taking it out of   }
  275.   R.Dx := FosPort;                      { the Bufffer                }
  276.   Intr ($14,R);
  277.   Fossil_Peek := Chr(R.Al)
  278. End;
  279.  
  280. Function Fossil_GetChar:Char;         { Gets Character from Input Buffer }
  281. Begin                                 { $FFFF if none: HIGH Byte is Scan }
  282.   R.Ah := $0D;                        { code                             }
  283.   R.Dx := FosPort;
  284.   Intr ($14,R);
  285.   Fossil_GetChar := Chr(R.Al)
  286. End;
  287.  
  288. Function Fossil_Wait:Char;            { Waits until a Character has been }
  289. Begin                                 { Receieved                        }
  290.   R.Ah := $0E;
  291.   R.Dx := FosPort;
  292.   Intr ($14,R);
  293.   Fossil_Wait := Chr(R.Al)
  294. End;
  295.  
  296. Procedure Fossil_FLOW (State:Byte);   { Sets Flow Control    }
  297. Begin                                 { 0 = Disabled         }
  298.   R.Ah := $0F;                        { Bit 0 & 3 = XON/XOFF } { Chars }
  299.   R.Al := State;                      { Bit 1     = CTS/RTS  } { Signals * }
  300.   R.Dx := FosPort;                    { Call using the defined Constants }
  301.   Intr ($14,R)
  302. End;
  303.  
  304.  
  305. Procedure Set_CtrlC (ComPort,State:Byte);
  306. Begin
  307.   R.Ah := $10;
  308.   R.Al := State;
  309.   R.Dx := ComPort - 1;
  310.   Intr ($14,R)
  311. End;
  312.  
  313. Function CtrlC_Check (ComPort:Byte):Boolean;
  314. Begin
  315.   R.Ah := $10;
  316.   R.Al := 2;
  317.   R.Dx := ComPort - 1;
  318.   Intr ($14,R);
  319.   CtrlC_Check := Boolean(R.Ax)
  320. End;
  321.  
  322. Procedure Fossil_GotoXY (X,Y:Byte);
  323. Begin
  324.   R.Ah := $11;
  325.   R.Dh := Y - 1;
  326.   R.Dl := X - 1;
  327.   Intr ($14,R)
  328. End;
  329.  
  330. Procedure Fossil_Position (Var X,Y:Byte);
  331. Begin
  332.   R.Ah := $12;
  333.   Intr ($14,R);
  334.   X := R.Dl + 1;
  335.   Y := R.Dh + 1
  336. End;
  337.  
  338. Function Fossil_WhereX:Byte;
  339. Begin
  340.   R.Ah := $12;
  341.   Intr ($14,R);
  342.   Fossil_WhereX := R.Dl + 1
  343. End;
  344.  
  345. Function Fossil_WhereY:Byte;
  346. Begin
  347.   R.Ah := $12;
  348.   Intr ($14,R);
  349.   Fossil_WhereY := R.Dh + 1
  350. End;
  351.  
  352. Procedure ANSI_Write (K:Char);        { Projects Character to Screen   }
  353. Begin                                 { through ANSI.SYS               }
  354.   R.Ah := $13;
  355.   R.Al := Ord(K);
  356.   R.Dx := FosPort;
  357.   Intr ($14,R)
  358. End;
  359.  
  360. Procedure WatchDog (Status:Boolean);  { Sets WatchDOG = ON/OFF        }
  361. Begin                                 { If ON then Reboots on Carrier }
  362.   R.Ah := $14;                        { Loss!                         }
  363.   R.Al := Byte(Status);
  364.   R.Dx := FosPort;
  365.   Intr ($14,R)
  366. End;
  367.  
  368. Procedure BIOS_Write (K:Char);        { Writes a Character to the     }
  369. Begin                                 { Screen Using BIOS Screen Write}
  370.   R.Ah := $15;
  371.   R.Al := Ord(K);
  372.   R.Dx := FosPort;
  373.   Intr ($14,R)
  374. End;
  375.  
  376. Function Add_Fossil_Proc (Var P):Boolean;
  377. Begin
  378.   R.Ah := $16;
  379.   R.Al := $01;
  380.   R.ES := Seg (P);
  381.   R.DX := Ofs (P);
  382.   Intr ($14,R);
  383.   Add_Fossil_Proc := R.Ax = 0
  384. End;
  385.  
  386. Function Delete_Fossil_Proc (Var P):Boolean;
  387. Begin
  388.   R.Ah := $16;
  389.   R.Al := $00;
  390.   R.ES := Seg (P);
  391.   R.DX := Ofs (P);
  392.   Intr ($14,R);
  393.   Delete_Fossil_Proc := R.Ax = 0
  394. End;
  395.  
  396. Procedure ColdBoot;                   { Does a Cold Reboot            }
  397. Begin
  398.   R.Ah := $17;
  399.   R.Al := $00;
  400.   Intr ($14,R)
  401. End;
  402.  
  403. Procedure WarmBoot;                   { Does a Warm Reboot            }
  404. Begin
  405.   R.Ah := $17;
  406.   R.Al := $01;
  407.   Intr ($14,R)
  408. End;
  409.  
  410. Function Fossil_BlockRead (Bytes:Word; Var Buffer):Integer;
  411. Begin                                 { BUFFER is an Array, and BYTES is  }
  412.   R.Ah := $18;                        { the size of the Array.            }
  413.   R.Dx := FosPort;                    { It Returns the number of recieved }
  414.   R.Cx := Bytes;                      { Characters.                       }
  415.   R.ES := Seg (Buffer);
  416.   R.DI := Ofs (Buffer);
  417.   Intr ($14,R);
  418.   Fossil_BlockRead := R.Ax
  419. End;
  420.  
  421. Function Fossil_BlockWrite (Bytes:Word; Var Buffer):Integer;
  422. Begin                                 { Writes an Array of BYTES Chars    }
  423.   R.Ah := $19;                        { to the FOSPORT from BUFFER        }
  424.   R.Dx := FosPort;                    { Returns the number of characters  }
  425.   R.Cx := Bytes;                      { sent.                             }
  426.   R.ES := Seg (Buffer);
  427.   R.DI := Ofs (Buffer);
  428.   Intr ($14,R);
  429.   Fossil_BlockWrite := R.Ax
  430. End;
  431.  
  432.  
  433. Function Fossil_Descrip (ComPort:Byte):String;
  434. Var Cnt:Integer;                      { Returns the Communications FOSSIL }
  435.     Fos_Arry:Fossil_Struct;           { Driver Utilizing the COMPORT      }
  436.     First,Second:Word;                { Communications Port               }
  437.     Kar:Char;                         { Returns the FOSSIL Driver         }
  438.     S:String;                         { Description.                      }
  439. Begin
  440.   R.Ah := $1B;
  441.   R.Dx := ComPort - 1;
  442.   R.ES := Seg (Fos_Arry);
  443.   R.DI := Ofs (Fos_Arry);
  444.   R.CX := SizeOf (Fos_Arry);
  445.   Intr ($14,R);
  446.   First  := Fos_Arry.FOS_ID[2];
  447.   Second := Fos_Arry.FOS_ID[1];
  448.   S   := '';
  449.   Kar := #26;
  450.   While Kar <> #0 Do Begin
  451.     Kar:=Chr (Mem[First:Second]);
  452.     S := S + Kar;
  453.     Second:=Second + 1
  454.   End;
  455.   Fossil_Descrip:=S
  456. End;
  457.  
  458. Begin
  459. End.
  460.