home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / turbopas / pmodem.ark / DIAL.INC < prev    next >
Encoding:
Text File  |  1987-02-22  |  3.9 KB  |  142 lines
  1.  
  2. {********** dial.inc **********}
  3.        { auto dial reoutines }
  4.  
  5. procedure call;
  6. {auto dial}
  7. label calloop;
  8. var
  9.   ch,ch1: char;
  10.   temp2: data;
  11.   temp4, line2: ldata;
  12.  
  13. function SubString(mainstring: data2; startNo, endNo: integer): dataa;
  14. var
  15.   len: integer;
  16. begin
  17.   len:= endNo - startNo;
  18.   if len < 1 then len:= 0;
  19.   SubString:= copy(mainstring, startNo, len + 1);
  20. end; {SubString}
  21.  
  22. procedure Phone_Directory;
  23.  
  24. var
  25.   show_directory: boolean;
  26.   position: integer;
  27.   local: char;
  28.   temp: string[95];
  29.  
  30. begin
  31.    if slowbaud then set_hiBaud;
  32.    slowbaud:= false;
  33.    logline:= '';
  34.    show_directory:= false;
  35.   { phone:= }
  36. if length(line)<2 then begin {line may already have value}
  37.      show_directory:= true;
  38.      writeln;
  39.      writeln('      Phone Directory');
  40.      writeln('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');
  41.    end
  42.    else begin
  43.      delete(line,1,1);
  44.      eraseOK:= false;
  45.    end;
  46.  
  47.      for I:= 1 to phone_list do begin
  48.        temp:=phone[I];
  49.        if temp[25]= '@' then begin
  50.           temp:= SubString(phone[I], 26, length(phone[I]));
  51.           position:= pos('/',temp);
  52.           if position<1 then position:= 0;
  53.           logline:= SubString(temp, position+1, length(temp));
  54.           temp:= SubString(phone[I], 1, 24 + position);
  55.         end;
  56.       if show_directory then begin
  57.         writeln(temp);
  58.         if I = 6 then writeln;
  59.       end;
  60.      end;
  61.      if show_directory then begin
  62.        if phone_list> 3 then writeln('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');
  63.        writeln;
  64.        write('letter, number / <RET> for menue: ');
  65.        readln(line);
  66.      end;
  67.  
  68.    if length(line)>0 then begin
  69.      line[1]:= upCase(line[1]);
  70.      if line[1] in ['A'..Chr(phone_list + 64)] then
  71.         line:= copy(phone[ord(line[1])-$40],25,95) {get phone number}
  72.      else if line[1] in [Chr(phone_list + 65)..'Z'] then line:= '';
  73.      if length(line)>0 then begin
  74.         if eraseOK then clrScr;
  75.         if line[1]= '@' then begin
  76.            autolog:= true;
  77.            delete(line,1,1);
  78.            position:= pos('/',line);
  79.            if position<1 then position:= 0;
  80.            logline:= SubString(line, position+1, length(line));
  81.            line:= SubString(line, 1, position-1);
  82.         end
  83.         else autolog:= false;
  84.         if line[1]= '~' then begin
  85.            delete(line,1,1);
  86.            slowbaud:= true;
  87.         end;
  88.         if slowbaud and not hiBaud then slowbaud:= false
  89.            else if slowbaud then set_loBaud;
  90.      end
  91.    end;
  92. end; {Phone_Directory}
  93.  
  94. begin  {call}
  95.    temp2:= 'Y'; line2:= '';
  96.    write('CALL ');
  97.    if length(phone_buffer)>0 then write('(', phone_buffer, ' previous)');
  98.    writeln;
  99.    Phone_Directory;
  100.    if length(line)>0 then begin
  101.      if line[1]= ' ' then line:= phone_buffer
  102.        else phone_buffer:= line;
  103.    delay(300);
  104.    CALLOOP:
  105.      writeln('dialing ',line);
  106.      ch:= CR;
  107.      go_Dial(line);
  108.      while ch in [CR, LF] do begin
  109.        if modem_in_ready then ch:= getMod;
  110.        if keyPressed then begin
  111.           ch1:= chr(bdos(1));
  112.           modem_out(' ');
  113.        end;
  114.      end;
  115.      if carrier then delay(500);
  116.      if carrier then terminal_mode
  117.      else begin
  118.          temp1:= getMod;
  119.          if upCase(temp2)= 'Y' then begin
  120.            write('Try again (Y/[N]/R)? ');
  121.            temp2:= upCase(chr(bdos(1)));
  122.            writeln;
  123.            if length(temp2)= 0 then temp2:= 'N';
  124.          end;
  125.          case temp2[1] of
  126.           'Y': goto calloop;
  127.           'R': begin
  128.                  time;
  129.                  if X<> ^X then goto calloop;
  130.                end;
  131.          end;
  132.      end;
  133.    end;
  134. if not carrier then begin
  135.    if slowbaud then set_hiBaud;
  136.    eraseOK:= true;
  137. end
  138. else eraseOK:= false;
  139. modem_out(^@); {any chr to hang up if dialing}
  140. end; {call}
  141.  
  142.