home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / modem / offhook.arc / OFFHOOK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-11-19  |  3.3 KB  |  163 lines
  1. Program OffHook;
  2. {$I Asynch.pas}
  3.      { PtoolWin.Inc}
  4. VAR
  5.   Command : String [80] Absolute Cseg:$0080;
  6.   Xstring : Array[1..4] of char;
  7.   Error   : Boolean;
  8.   k       : Char;
  9. procedure Windowshade(x1,y1,x2,y2:integer);
  10. var
  11.     i,
  12.     Y : integer;
  13. begin
  14.  
  15.    TextBackGround(white);
  16.    TextColor(black);
  17.    For Y := y2-1 downto y1 Do
  18.    begin
  19.      Window(x1,y,x2,y2);
  20.      clrscr;
  21.      delay(30);
  22.    end;
  23.  
  24.       GoToXy(1,1); Write('╔');
  25.       for i := 2 to x2-x1 do
  26.       write('═');
  27.       write('╗');
  28.       for i := 2 to y2-y1 do
  29.       begin Gotoxy(1,i);write('║');
  30.             gotoxy(x2-x1+1,i);Write('║');
  31.       end;
  32.       gotoxy(1,y2-y1+1); Write('╚');
  33.       for i := 2 to x2-x1 do
  34.       write('═');
  35.  
  36.    Window(x1+1,y1+1,x2-1,y2-1);
  37.    write('╝');
  38.  
  39.    TextColor(white);
  40.    TextBackGround(black);
  41.    clrscr;
  42.  
  43. end;
  44.  
  45.  
  46.  
  47. procedure Wait;
  48. begin
  49.  
  50.    while not keypressed do
  51.    delay (20);
  52.    read(kbd,K);
  53.    {PTWClose;}
  54.  
  55. end;
  56. procedure parseCom;
  57. var start,
  58.         j,
  59.         i : integer;
  60. begin
  61.  
  62.    start := 1;
  63.    While Command[start] = ' ' do
  64.    start := start + 1;
  65.  
  66.    j :=1;
  67.    For i := start to start+3 do
  68.    begin
  69.      Xstring[j] :=  UpCase(Command[i]);
  70.      j := j+1;
  71.    end;
  72.  
  73.    If Xstring = 'COM1' then  OpenCom(Com1,b1200,pNone,d8,s1) else
  74.    If Xstring = 'COM2' then  OpenCom(Com2,b1200,pNone,d8,s1) else
  75.       Error := True;
  76.  
  77. end;
  78. Procedure Instruct;
  79. Begin
  80.  
  81.  
  82.    Windowshade(5,3,75,23);ClrScr; GoToXy(1,1);
  83.    WriteLn('  Program Offhook. Version 1.1 19 nov 1985');
  84.    Writeln('     Takes Hayes-comaptable modem connected to Com1 or Com2');
  85.    WriteLn('  and sets it off-hook so callers get a busy signal.    ');
  86.    WriteLn('     Set which com-port by command line parameters, that is');
  87.    WriteLn('  for Com1, enter: ');
  88.    WriteLn('  OFFHOOK COM1<cr>');
  89.    Writeln('  for Com2, enter: ');
  90.    WriteLn('  OFFHOOK COM2<cr>');
  91.    Writeln('     Send comments or bug reports to The Wizard, ');
  92.    Writeln('     The Wizards Tower, Fido 102/16, (201)-288-9076.');
  93.    WriteLn(' ');
  94.    Writeln('  Press any key to exit.');
  95.    WriteLn(' ');
  96.    wait;
  97.  
  98. End;
  99. Procedure ReportError;
  100. var key : char;
  101.  
  102. Procedure warble;
  103. var tone : integer;
  104.     x    : real;
  105. begin
  106.     tone := 8000;
  107.     while tone >199 do
  108.     begin
  109.         sound(tone);
  110.         delay(1);
  111.         x := tone;
  112.         x := x * 0.95;
  113.         tone := trunc(x);
  114.     end;
  115.     nosound;
  116. end;
  117. {---------}
  118. Begin
  119.  
  120.    Windowshade(20,10,60,15); clrscr; GoToXy(1,1);
  121.    Writeln(' OffHook Version 1.1 19 nov 1985');
  122.    WriteLn(' No such port as ',Xstring);
  123.    Write  (' Press any key to exit.');
  124.    While not keypressed do
  125.    begin
  126.      Delay(50);
  127.      warble;
  128.    end;
  129.    Read(KBD,key);
  130.  
  131. End;
  132. procedure reportOpen;
  133. begin
  134.  
  135.    WriteCom('AT M0');
  136.    Delay(1500);
  137.    WriteCom('AT H1');
  138.    Delay(1500);
  139.    CloseCom;
  140.    ClrScr; Gotoxy(10,10);
  141.    Windowshade(20,10,60,15); clrscr; Gotoxy(1,1);
  142.    WriteLn (' OffHook Version 1.1, 19 Nov 1985');
  143.    WriteLn (' Port ',Xstring,' set off hook.');
  144.  
  145. end;
  146.  
  147. BEGIN
  148.  
  149.    {PTWSET(1,5,2,75,23,-2,3,0);
  150.    PTWSet(2,20,10,60,15,2,0,14);}
  151.  
  152.    Error := False;
  153.  
  154.    If Length(Command) >= 4
  155.    Then Begin
  156.           ParseCom;
  157.           If Error
  158.           Then ReportError
  159.           Else ReportOpen;
  160.         end
  161.    Else Instruct;
  162.  
  163. END.