home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / 22rsx / byestuff.ark / DIAL.PAS < prev    next >
Pascal/Delphi Source File  |  1985-11-23  |  3KB  |  119 lines
  1. PROGRAM dial(access, cmd, input, output);
  2.  
  3.   CONST
  4.     maxcodes      = 2;
  5. (*$s-*)
  6.     cr            = (:13:);
  7. (*$s+*)
  8.  
  9. (*$i'rsxcalls.inc' *)
  10.  
  11. (*$i'strings.dec' *)
  12.  
  13.   VAR
  14.     codes         : ARRAY[1..maxcodes] OF string;
  15.     stopped       : boolean;
  16.     access,
  17.     cmd           : text;
  18.  
  19.     (* initialized strings *)
  20.     atz,
  21.     atinit,
  22.     atdp          : string;
  23.  
  24. (*$l-,i'strings.inc' *)
  25. (*$l+*)
  26.  
  27.   (* 1-----------------1 *)
  28.  
  29.   PROCEDURE putchar(c : char); (* to modem port directly *)
  30.  
  31.     VAR
  32.       junk     : integer;
  33.  
  34.     BEGIN (* putchar *)
  35.     WHILE syscall(moutstat, 0) = 0 DO (* wait *)
  36.     junk := syscall(mout, c);
  37.     END; (* putchar *)
  38.  
  39.   (* 1-----------------1 *)
  40.  
  41.   PROCEDURE putmdmstring(VAR s : string);
  42.  
  43.     VAR
  44.       i      : integer;
  45.  
  46.     BEGIN (* putmdmstring *)
  47.     i := 1;
  48.     WHILE s[i] <> eos DO BEGIN
  49.       write(s[i]); putchar(s[i]); i := succ(i); END;
  50.     END; (* putmdmstring *)
  51.  
  52.   (* 1-----------------1 *)
  53.  
  54.   PROCEDURE skipblanks(VAR f : text);
  55.  
  56.     BEGIN (* skipblanks *)
  57.     WHILE NOT eoln(f) AND (f^ = ' ') DO get(f);
  58.     END; (* skipblanks *)
  59.  
  60.   (* 1-----------------1 *)
  61.  
  62.   PROCEDURE setupstrings;
  63.   (* sets up long-distance access codes *)
  64.  
  65.     VAR
  66.       i        : integer;
  67.  
  68.     BEGIN (* setupstrings *)
  69.     FOR i := 1 TO maxcodes DO codes[i, 1] := eos;
  70.     i := 1;
  71.     IF exists(access) THEN
  72.       WHILE NOT eof(access) AND (i <= maxcodes) DO BEGIN
  73.         readlnstring(access, codes[i]); i := succ(i); END;
  74. (*$s-                    123456789o123456789o *)
  75.     atdp  [1 FOR  4] := 'ATDP';             atdp  [ 5] := eos;
  76.     atz   [1 FOR  3] := 'ATZ';              atz   [ 4] := eos;
  77.     atinit[1 FOR 16] := 'ATE0Q0V0S0=0M1X1'; atinit[17] := eos;
  78. (*$s+                    123456789o123456789o *)
  79.     stringextend(atz, cr, true); stringextend(atinit, cr, true);
  80.     END; (* setupstrings *)
  81.  
  82.   (* 1-----------------1 *)
  83.  
  84.   PROCEDURE dialone(VAR f : text);
  85.   (* reads the next number and tries to call.  Terminates program *)
  86.   (* after setting up call if connection successful, else returns *)
  87.  
  88.     BEGIN (* dialone *)
  89.     IF odd(status(input) DIV 2) THEN readln;
  90.     putmdmstring(atdp);
  91.     IF f^ IN ['<', '>'] THEN BEGIN
  92.       IF      f^ = '<' THEN putmdmstring(codes[1])
  93.       ELSE IF f^ = '>' THEN putmdmstring(codes[2]);
  94.       write(f^); get(f); END;
  95.     WHILE NOT eoln(f) AND (f^ <> ';') DO BEGIN
  96.       write(f^); putchar(f^); get(f); END;
  97.     IF NOT eoln(f) THEN get(f);
  98.     putchar(cr); writeln;
  99.     END; (* dialone *)
  100.  
  101.   (* 1-----------------1 *)
  102.  
  103.   BEGIN (* dial *)
  104.   IF syscall(RSX, 0) = 0 THEN writeln('BYERSX not running')
  105.   ELSE BEGIN
  106.     setupstrings;
  107.     REPEAT
  108.       reset(cmd); skipblanks(cmd);
  109.       IF cmd^ = '(' THEN BEGIN
  110.         get(cmd);
  111.         WHILE NOT eoln(cmd) AND (cmd^ <> ')') DO get(cmd);
  112.         IF cmd^= ')' THEN get(cmd);
  113.         skipblanks(cmd); END;
  114.       stopped := eoln(cmd);
  115.       WHILE NOT eoln(cmd) DO BEGIN
  116.         dialone(cmd); skipblanks(cmd); END;
  117.     UNTIL stopped; END;
  118.   END. (* dial *)
  119. S