home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / DOOR / DDPLUS67.ZIP / DDFOSSIL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-21  |  5KB  |  274 lines
  1.  
  2.  
  3. unit ddfossil;
  4. {$S-,V-,R-}
  5.  
  6. interface
  7. uses dos;
  8.  
  9. type
  10.  fossildatatype = record
  11.                    strsize: word;
  12.                    majver: byte;
  13.                    minver: byte;
  14.                    ident: pointer;
  15.                    ibufr: word;
  16.                    ifree: word;
  17.                    obufr: word;
  18.                    ofree: word;
  19.                    swidth: byte;
  20.                    sheight: byte;
  21.                    baud: byte;
  22.                   end;
  23. var
  24.  port_num: integer;
  25.  fossildata: fossildatatype;
  26.  
  27. procedure async_send(ch: char);
  28. procedure async_send_string(s: string);
  29. function async_receive(var ch: char): boolean;
  30. function async_carrier_drop: boolean;
  31. function async_carrier_present : boolean;
  32. function async_buffer_check: boolean;
  33. function async_init_fossil: boolean;
  34. procedure async_deinit_fossil;
  35. procedure async_flush_output;
  36. procedure async_purge_output;
  37. procedure async_purge_input;
  38. procedure async_set_dtr(state: boolean);
  39. procedure async_watchdog_on;
  40. procedure async_watchdog_off;
  41. procedure async_warm_reboot;
  42. procedure async_cold_reboot;
  43. procedure async_set_baud(n: longint);
  44. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  45. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  46.  
  47. implementation
  48.  
  49. procedure async_send(ch: char);
  50. var
  51.  regs: registers;
  52. begin;
  53.  regs.al:=ord(ch);
  54.  regs.dx:=port_num;
  55.  regs.ah:=$01;
  56.  intr($14,regs);
  57. end;
  58.  
  59. procedure async_send_string(s: string);
  60. var
  61.  a: integer;
  62. begin;
  63.  for a:=1 to length(s) do async_send(s[a]);
  64. end;
  65.  
  66. function async_receive(var ch: char): boolean;
  67. var
  68.  regs: registers;
  69. begin;
  70.  ch:=#0;
  71.  regs.ah:=$03;
  72.  regs.dx:=port_num;
  73.  intr($14,regs);
  74.  if (regs.ah and 1)=1 then begin;
  75.   regs.ah:=$02;
  76.   regs.dx:=port_num;
  77.   intr($14,regs);
  78.   ch:=chr(regs.al);
  79.   async_receive:=true;
  80.  end else async_receive:=false;
  81. end;
  82.  
  83. function async_carrier_drop: boolean;
  84. var
  85.  regs: registers;
  86. begin;
  87.  regs.ah:=$03;
  88.  regs.dx:=port_num;
  89.  intr($14,regs);
  90.  if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;
  91. end;
  92.  
  93. function async_carrier_present: boolean;
  94. var
  95.  regs: registers;
  96. begin;
  97.  regs.ah:=$03;
  98.  regs.dx:=port_num;
  99.  intr($14,regs);
  100.  if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;
  101. end;
  102.  
  103. function async_buffer_check: boolean;
  104. var
  105.  regs: registers;
  106. begin;
  107.  regs.ah:=$03;
  108.  regs.dx:=port_num;
  109.  intr($14,regs);
  110.  if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;
  111. end;
  112.  
  113. function async_init_fossil: boolean;
  114. var
  115.  regs: registers;
  116. begin;
  117.  regs.ah:=$04;
  118.  regs.bx:=$00;
  119.  regs.dx:=port_num;
  120.  intr($14,regs);
  121.  if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;
  122. end;
  123.  
  124. procedure async_deinit_fossil;
  125. var
  126.  regs: registers;
  127. begin;
  128.  regs.ah:=$05;
  129.  regs.dx:=port_num;
  130.  intr($14,regs);
  131. end;
  132.  
  133. procedure async_set_dtr(state: boolean);
  134. var
  135.  regs: registers;
  136. begin;
  137.  regs.ah:=$06;
  138.  if state then regs.al:=1 else regs.al:=0;
  139.  regs.dx:=port_num;
  140.  intr($14,regs);
  141. end;
  142.  
  143. procedure async_flush_output;
  144. var
  145.  regs: registers;
  146. begin;
  147.  regs.ah:=$08;
  148.  regs.dx:=port_num;
  149.  intr($14,regs);
  150. end;
  151.  
  152. procedure async_purge_output;
  153. var
  154.  regs: registers;
  155. begin;
  156.  regs.ah:=$09;
  157.  regs.dx:=port_num;
  158.  intr($14,regs);
  159. end;
  160.  
  161. procedure async_purge_input;
  162. var
  163.  regs: registers;
  164. begin;
  165.  regs.ah:=$0A;
  166.  regs.dx:=port_num;
  167.  intr($14,regs);
  168. end;
  169.  
  170. procedure async_watchdog_on;
  171. var
  172.  regs: registers;
  173. begin;
  174.  regs.ah:=$14;
  175.  regs.al:=$01;
  176.  regs.dx:=port_num;
  177.  intr($14,regs);
  178. end;
  179.  
  180. procedure async_watchdog_off;
  181. var
  182.  regs: registers;
  183. begin;
  184.  regs.ah:=$14;
  185.  regs.al:=$00;
  186.  regs.dx:=port_num;
  187.  intr($14,regs);
  188. end;
  189.  
  190. procedure async_warm_reboot;
  191. var
  192.  regs: registers;
  193. begin;
  194.  regs.ah:=$17;
  195.  regs.al:=$01;
  196.  intr($14,regs);
  197. end;
  198.  
  199. procedure async_cold_reboot;
  200. var
  201.  regs: registers;
  202. begin;
  203.  regs.ah:=$17;
  204.  regs.al:=$00;
  205.  intr($14,regs);
  206. end;
  207.  
  208. procedure async_set_baud(n: longint);
  209. var
  210.  w : word;
  211.  regs: registers;
  212. begin;
  213.  regs.ah:=$00;
  214.  regs.al:=$03;
  215.  regs.dx:=port_num;
  216.  w := n;
  217.  If n < 65536 then
  218.    case w of
  219.      300  : regs.al:=regs.al or $40;
  220.      600  : regs.al:=regs.al or $60;
  221.      1200 : regs.al:=regs.al or $80;
  222.      2400 : regs.al:=regs.al or $A0;
  223.      4800 : regs.al:=regs.al or $C0;
  224.      9600 : regs.al:=regs.al or $E0;
  225.      19200: regs.al:=regs.al or $00;
  226.      38400: regs.al:=regs.al or $20;
  227.      57600: regs.al:=regs.al or $40;
  228.    end
  229.  else
  230.  If n = 76800 then
  231.    regs.al:=regs.al or $60
  232.  else
  233.  If n = 115200 then
  234.    regs.al:=regs.al or $80;
  235.  
  236.  intr($14,regs);
  237. end;
  238.  
  239. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  240. var
  241.  regs: registers;
  242. begin;
  243.  regs.ah:=$0F;
  244.  regs.al:=$00;
  245.  if softtran then regs.al:=regs.al or $01;
  246.  if Hard then regs.al:=regs.al or $02;
  247.  if SoftRecv then regs.al:=regs.al or $08;
  248.  regs.al:=regs.al or $F0;
  249.  Intr($14,regs);
  250. end;
  251.  
  252. procedure async_get_fossil_data;
  253. var
  254.  regs: registers;
  255. begin;
  256.  regs.ah:=$1B;
  257.  regs.cx:=sizeof(fossildata);
  258.  regs.dx:=port_num;
  259.  regs.es:=seg(fossildata);
  260.  regs.di:=ofs(fossildata);
  261.  intr($14,regs);
  262. end;
  263.  
  264. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  265. begin;
  266.  async_get_fossil_data;
  267.  insize:=fossildata.ibufr;
  268.  infree:=fossildata.ifree;
  269.  outsize:=fossildata.obufr;
  270.  outfree:=fossildata.ofree;
  271. end;
  272.  
  273. end.
  274.