home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / MODEM.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-22  |  3KB  |  144 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit modem;
  5.  
  6. interface
  7.  
  8. uses crt,dos,configrt,general;
  9.  
  10. const RBR=$3F8; THR=$3F8; DLL=$3F8; DLM=$3F9; IER=$3F9;
  11.       IIR=$3FA; LCR=$3FB; MCR=$3FC; LSR=$3FD; MSR=$3FE;
  12.       intnum=255;
  13.  
  14. var icomoffset:integer;
  15.  
  16. procedure mfunc (var r:registers; ahval,alval:byte);
  17. procedure sendchar (k:char);
  18. function numchars:integer;
  19. function getchar:char;
  20. procedure gayger;
  21. procedure hangup;
  22. procedure setoutbuffer (size:integer);
  23. procedure setparam (comnum:byte; baud:integer; parity:boolean);
  24. function carrier:boolean;
  25. function driverpresent:boolean;
  26. procedure setterminalready (b:boolean);
  27. procedure dontanswer;
  28. procedure doanswer;
  29.  
  30. implementation
  31.  
  32. procedure mfunc (var r:registers; ahval,alval:byte);
  33. begin
  34.   r.ax:=alval+(ahval shl 8);
  35.   intr (intnum,r)
  36. end;
  37.  
  38. procedure sendchar (k:char);
  39. var r:registers;
  40.     kkk:char;
  41.  
  42. function scramble (s:char):char;
  43. var f:text;
  44.     x,y:char;
  45.     z:integer;
  46. begin
  47.  scramble:=s;
  48.  if noscramble then exit;
  49.  if not scrambled then exit;
  50.  if not exist (forumdir+'Scramble.Dat') then exit;
  51.  if not (ord(s) in [65..90,97..122]) then exit;
  52.  assign (f,forumdir+'Scramble.Dat');
  53.  reset (f);
  54.  for z:=1 to ord(s) do
  55.  read (f,x);
  56.  scramble:=x;
  57.  close (f);
  58. end;
  59.  
  60. begin
  61.   if scrambled then begin
  62.    kkk:=scramble (k);
  63.   end else kkk:=k;
  64.   mfunc (r,3,ord(kkk))
  65. end;
  66.  
  67. function numchars:integer;
  68. var r:registers;
  69. begin
  70.   mfunc (r,1,0);
  71.   numchars:=r.ax
  72. end;
  73.  
  74. function getchar:char;
  75. var r:registers;
  76. begin
  77.   mfunc (r,2,0);
  78.   getchar:=chr(r.ax and 255)
  79. end;
  80.  
  81. procedure gayger;
  82. var r:registers;
  83. begin
  84.   mfunc (r,2,0);
  85. end;
  86.  
  87. procedure hangup;
  88. var r:registers;
  89. begin
  90.   mfunc (r,6,0);
  91.   delay (200)
  92. end;
  93.  
  94. procedure setoutbuffer (size:integer);
  95. var r:registers;
  96. begin
  97.   r.bx:=size;
  98.   mfunc (r,8,0)
  99. end;
  100.  
  101. procedure setparam (comnum:byte; baud:integer; parity:boolean);
  102. var r:registers;
  103.     p:byte;
  104. begin
  105.   mfunc (r,0,comnum);
  106.   r.bx:=baud;
  107.   if parity then p:=1 else p:=0;
  108.   mfunc (r,7,p);
  109.   setoutbuffer (baud div 30);
  110.   case comnum of
  111.     1:icomoffset:=0;
  112.     2:icomoffset:=-256
  113.   end
  114. end;
  115.  
  116. function carrier:boolean;
  117. begin
  118.   carrier:=(port[msr+icomoffset] and 128)=128
  119. end;
  120.  
  121. function driverpresent:boolean;
  122. begin
  123.   driverpresent:=memw[memw[0:intnum*4+2]:memw[0:intnum*4]]=7686
  124. end;
  125.  
  126. procedure setterminalready (b:boolean);
  127. begin
  128.   port [icomoffset+mcr]:=ord(b) or 8
  129. end;
  130.  
  131. procedure dontanswer;
  132. begin
  133.   setterminalready (false)
  134. end;
  135.  
  136. procedure doanswer;
  137. begin
  138.   setterminalready (true)
  139. end;
  140.  
  141. begin
  142. end.
  143.  
  144.