home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TM40.ZIP / TM3.INC < prev   
Encoding:
Text File  |  1985-07-20  |  36.6 KB  |  1,180 lines
  1. (****************************************************************************)
  2. (*                   CHANGE COMMUNICATION PARAMETERS                        *)
  3. (****************************************************************************)
  4.    procedure
  5.       change_comm_params;
  6.    begin
  7.       mkwin(13,7,64,18,'Change Parameters');
  8.       writeln;
  9.       write('    Current Setting: ',baud:4);
  10.       case par of
  11.          0 : write(' N');
  12.          1 : write(' E');
  13.          2 : write(' O');
  14.       end;
  15.       writeln(databits:2,stopbits:2);
  16.       writeln;
  17.       writeln('       Enter New Parameters.');
  18.       writeln('       ---------------------');
  19.       write('    Baud Rate, 300,1200,2400,4800,9600 : ');
  20.       readln(baud_ch);
  21.       if length(baud_ch)>0 then begin
  22.          baud:=bval(baud_ch);
  23.          case baud of
  24.             300  : ;
  25.             1200 : ;
  26.             2400 : ;
  27.             4800 : ;
  28.             9600 : ;
  29.          else
  30.             baud := default_baud;
  31.          end;
  32.       end;
  33.       write('    Parity, (N)one, (E)ven, (O)dd      : ');
  34.       readln(parity_ch);
  35.       if length(parity_ch)>0 then begin
  36.          parity_ch := upcase(parity_ch[1]);
  37.          case parity_ch of
  38.             'N' : par:=0;
  39.             'E' : par:=1;
  40.             'O' : par:=2;
  41.          else
  42.             par:=0;
  43.          end;
  44.       end;
  45.       write('    Data Bits, 7 or 8                  : ');
  46.       readln(data_ch);
  47.       if length(data_ch)>0 then begin
  48.          databits := bval(data_ch);
  49.          case databits of
  50.             7 : ;
  51.             8 : ;
  52.          else
  53.             databits := 8;
  54.          end;
  55.       end;
  56.       write('    Stop Bits, 1 or 2                  : ');
  57.       readln(stop_ch);
  58.       if length(stop_ch)>0 then begin
  59.          stopbits := bval(stop_ch);
  60.          case stopbits of
  61.             1 : ;
  62.             2 : ;
  63.          else
  64.             stopbits := 1;
  65.          end;
  66.       end;
  67.       setserial(baud,stopbits,databits,par);
  68.       rmwin;
  69.    end;
  70.  
  71. (****************************************************************************)
  72. (*                        PAINT DIRECTORY SCREEN                            *)
  73. (****************************************************************************)
  74.    procedure
  75.       paint_directory_screen(en : integer);
  76.    var
  77.       i   : integer;
  78.       row : integer;
  79.       num : integer;
  80.    begin
  81.       for i:=en to max_dial_entries do begin
  82.          row := i + 3;
  83.          num := ( dialarray_number * max_dial_entries ) + i;
  84.          gotoxy(1,row);
  85.          write(num:3,' ');
  86.          clreol;
  87.          with dial_dir do begin
  88.             if i <= no_of_dial_entries then begin
  89.                with dir_entries[i] do begin
  90.                   gotoxy(5,row);
  91.                   write(bbs_name);
  92.                   gotoxy(36,row);
  93.                   write(bbs_number);
  94.                   gotoxy(67,row);
  95.                   write(bbs_baud:4);
  96.                   gotoxy(72,row);
  97.                   case bbs_parity of
  98.                      0 : write('N ');
  99.                      1 : write('E ');
  100.                      2 : write('O ');
  101.                   end;
  102.                   write(bbs_databits,' ',bbs_stopbits);
  103.                end;
  104.             end;
  105.          end;
  106.          writeln;
  107.       end;
  108.    end;
  109.  
  110. (****************************************************************************)
  111. (*                          GET DIRECTORY INFO                              *)
  112. (****************************************************************************)
  113.    procedure
  114.       get_info(i  :  integer);
  115.    var
  116.       entry_no    : integer;
  117.    begin
  118.       entry_no := i - 3;
  119.       with dial_dir.dir_entries[entry_no] do begin
  120.          gotoxy(5,i);
  121.          str_input(bbs_name);
  122.          gotoxy(36,i);
  123.          str_input(bbs_number);
  124.          gotoxy(67,i);
  125.          if bbs_baud = 0 then begin
  126.             baud_ch := '';
  127.             parity_ch := '';
  128.             data_ch := '';
  129.             stop_ch := '';
  130.          end
  131.          else begin
  132.             str(bbs_baud:4,baud_ch);
  133.             case bbs_parity of
  134.                0 : parity_ch := 'N';
  135.                1 : parity_ch := 'E';
  136.                2 : parity_ch := 'O';
  137.             else
  138.                parity_ch := ' ';
  139.             end;
  140.             str(bbs_databits:1,data_ch);
  141.             str(bbs_stopbits:1,stop_ch);
  142.          end;
  143.          str_input(baud_ch);
  144.          bbs_baud := bval(baud_ch);
  145.          case bbs_baud of
  146.             300  : ;
  147.             1200 : ;
  148.             2400 : ;
  149.             4800 : ;
  150.             9600 : ;
  151.          else
  152.             bbs_baud := default_baud;
  153.          end;
  154.          gotoxy(72,i);
  155.          str_input(parity_ch);
  156.          parity_ch := upcase(parity_ch[1]);
  157.          case parity_ch of
  158.             'N' : bbs_parity := 0;
  159.             'E' : bbs_parity := 1;
  160.             'O' : bbs_parity := 2;
  161.          else
  162.             bbs_parity := 0;
  163.          end;
  164.          gotoxy(73,i);
  165.          write(' ');
  166.          str_input(data_ch);
  167.          bbs_databits := bval(data_ch);
  168.          case bbs_databits of
  169.             7 : ;
  170.             8 : ;
  171.          else
  172.             bbs_databits := 8;
  173.          end;
  174.          gotoxy(76,i);
  175.          str_input(stop_ch);
  176.          bbs_stopbits := bval(stop_ch);
  177.          case bbs_stopbits of
  178.             1 : ;
  179.             2 : ;
  180.          else
  181.             bbs_stopbits := 1;
  182.          end;
  183.       end;
  184.    end;
  185.  
  186. (****************************************************************************)
  187. (*                          ADD DIRECTORY ENTRY                             *)
  188. (****************************************************************************)
  189.    procedure
  190.       add_dial_entry;
  191.    var
  192.       row    : integer;
  193.       ch     : char;
  194.    begin
  195.       with dial_dir do begin
  196.          while no_of_dial_entries = max_dial_entries do begin
  197.             dialarray_number := succ(dialarray_number);
  198.             {$I-}
  199.             seek(dialfile,dialarray_number);
  200.             read(dialfile,dial_dir);
  201.             {$I+}
  202.             ok := (ioresult=0);
  203.             if not ok then begin
  204.                seek(dialfile,dialarray_number);
  205.                no_of_dial_entries := 0;
  206.                write(dialfile,dial_dir);
  207.             end;
  208.          end;
  209.          paint_directory_screen(1);
  210.          no_of_dial_entries := succ(no_of_dial_entries);
  211.          row := no_of_dial_entries + 3;
  212.          with dir_entries[no_of_dial_entries] do begin
  213.             bbs_name := '';
  214.             bbs_number := '';
  215.             bbs_baud := 0;
  216.             bbs_parity := 0;
  217.             bbs_databits := 8;
  218.             bbs_stopbits := 1;
  219.          end;
  220.          get_info(row);
  221.          seek(dialfile,dialarray_number);
  222.          write(dialfile,dial_dir);
  223.       end;
  224.    end;
  225.  
  226. (****************************************************************************)
  227. (*                        CHANGE DIRECTORY ENTRY                            *)
  228. (****************************************************************************)
  229.    procedure
  230.       change_dial_entry;
  231.    var
  232.       i   : integer;
  233.       row : integer;
  234.    begin
  235.       mkwin(41,1,71,5,'Update');
  236.       writeln;
  237.       write(' Enter the # to change: ');
  238.       readln(i);
  239.       rmwin;
  240.       i := i - (dialarray_number * max_dial_entries);
  241.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  242.          row := i + 3;
  243.          get_info(row);
  244.          seek(dialfile,dialarray_number);
  245.          write(dialfile,dial_dir);
  246.       end;
  247.    end;
  248.  
  249. (****************************************************************************)
  250. (*                         DELETE DIRECTORY ENTRY                           *)
  251. (****************************************************************************)
  252.    procedure
  253.       delete_dial_entry;
  254.    var
  255.       i,j    : integer;
  256.    begin
  257.       mkwin(41,1,71,5,'Delete');
  258.       writeln;
  259.       write(' Enter the # to delete: ');
  260.       readln(i);
  261.       rmwin;
  262.       j := i - (dialarray_number * max_dial_entries);
  263.       i := j;
  264.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  265.          with dial_dir do begin
  266.             while i < no_of_dial_entries do begin
  267.                dir_entries[i] := dir_entries[ succ( i ) ];
  268.                i := succ( i );
  269.             end;
  270.             no_of_dial_entries := pred(no_of_dial_entries);
  271.             paint_directory_screen(j);
  272.             seek(dialfile,dialarray_number);
  273.             write(dialfile,dial_dir);
  274.          end;
  275.       end;
  276.    end;
  277.  
  278. (****************************************************************************)
  279. (*                                DIALER                                    *)
  280. (****************************************************************************)
  281.    procedure
  282.       dialer;
  283.    var
  284.       i  : byte;
  285.    begin
  286.       for i:=1 to length( dial_str ) do begin
  287.          case dial_str[i] of
  288.              '|' : store_sout_buffer( CR );
  289.              '~' : delay( a_second );
  290.          else
  291.             store_sout_buffer( dial_str[i] );
  292.          end;
  293.          delay( wait_increment div 11 );
  294.       end;
  295.       delay( wait_increment );
  296.    end;
  297.  
  298. (****************************************************************************)
  299. (*                           MANUAL DIAL MODEM                              *)
  300. (****************************************************************************)
  301.    procedure
  302.       manual_dial;
  303.    begin
  304.       mkwin(25,1,71,5,'Manual Dial');
  305.       writeln;
  306.       write(' Enter Phone Number: ');
  307.       readln(dial_str);
  308.       dial_str := dial_pre_str + dial_str + dial_post_str;
  309.       redial_number := dial_str;
  310.       change_comm_params;
  311.       redial_name := '';
  312.       dialer;
  313.       dial_time := time;
  314.       initialize_music;
  315.       rmwin;
  316.    end;
  317.  
  318. (****************************************************************************)
  319. (*                            AUTO DIAL MODEM                               *)
  320. (****************************************************************************)
  321.    procedure
  322.       auto_dial;
  323.    var
  324.       i        : integer;
  325.    begin
  326.       mkwin(41,1,71,5,'Auto Dial');
  327.       writeln;
  328.       write(' Enter the # to dial: ');
  329.       i := 0;
  330.       num_input(i);
  331.       writeln;
  332.       i := i - (dialarray_number * max_dial_entries);
  333.       if ( I > 0 ) and ( i <= max_dial_entries ) then begin
  334.          with dial_dir.dir_entries[i] do begin
  335.             baud := bbs_baud;
  336.             stopbits := bbs_stopbits;
  337.             databits := bbs_databits;
  338.             par := bbs_parity;
  339.             setserial(baud,stopbits,databits,par);
  340.             dial_str := dial_pre_str + bbs_number + dial_post_str;
  341.             redial_number := dial_str;
  342.             redial_name := bbs_name;
  343.             dialer;
  344.             dial_time := time;
  345.             initialize_music;
  346.          end;
  347.       end
  348.       else begin
  349.          writeln(' Number must be on screen.');
  350.          wait_for_key;
  351.       end;
  352.       rmwin;
  353.    end;
  354.  
  355. (****************************************************************************)
  356. (*                             PAGE FORWARD                                 *)
  357. (****************************************************************************)
  358.    procedure
  359.       page_forward;
  360.    var
  361.       fsize : integer;
  362.    begin
  363.       fsize := filesize(dialfile) - 1;
  364.       if dialarray_number = fsize then exit;
  365.       dialarray_number := succ(dialarray_number);
  366.       seek(dialfile,dialarray_number);
  367.       read(dialfile,dial_dir);
  368.       paint_directory_screen(1);
  369.    end;
  370.  
  371. (****************************************************************************)
  372. (*                             PAGE BACKWARD                                *)
  373. (****************************************************************************)
  374.    procedure
  375.       page_backward;
  376.    begin
  377.       if dialarray_number = 0 then exit;
  378.       dialarray_number := pred(dialarray_number);
  379.       seek(dialfile,dialarray_number);
  380.       read(dialfile,dial_dir);
  381.       paint_directory_screen(1);
  382.    end;
  383.  
  384. (****************************************************************************)
  385. (*                           DIRECTORY MANAGER                              *)
  386. (****************************************************************************)
  387.    procedure
  388.       directory_manager;
  389.    begin
  390.       gotoxy(30,1);
  391.       writeln('Phone Directory');
  392.       writeln('  #         BBS Name                     Phone Number             Baud P D S');
  393.       writeln(' -- ------------------------------ ------------------------------ ---- - - -');
  394.       paint_directory_screen(1);
  395.       writeln;
  396.       write(' A=Add, C=Chg, K=Kill, M=M.Dial, D=A.Dial, S=Stop, F=PgFwd, B=PgBak, Q=Quit');
  397.       delay( a_second );
  398.       repeat
  399.          gotoxy(77,21);
  400.          kbd_char := ' ';
  401.          if keypressed then begin
  402.             read(kbd,kbd_char);
  403.             kbd_char := upcase(kbd_char);
  404.             case kbd_char of
  405.                'A' : add_dial_entry;
  406.                'C' : change_dial_entry;
  407.                'K' : delete_dial_entry;
  408.                'M' : manual_dial;
  409.                'G','D'
  410.                    : auto_dial;
  411.                'S' : store_sout_buffer(' ');
  412.                'F' : page_forward;
  413.                'B' : page_backward;
  414.                'Q' : ;
  415.             end;
  416.          end;
  417.          if (( port[modem_status_reg] and $80 ) <> 0)
  418.             and (forced_carrier[1] = 'F') then
  419.                kbd_char := 'Q';
  420.       until kbd_char = 'Q';
  421.    end;
  422.  
  423. (****************************************************************************)
  424. (*                             MODEM DIALER                                 *)
  425. (****************************************************************************)
  426.    procedure
  427.       dial_modem;
  428.    begin
  429.       dial_str := speaker_on;
  430.       dialer;
  431.       mkwin(1,1,80,23,'');
  432.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  433.       {$I-};
  434.       reset(dialfile);
  435.       {$I+}
  436.       ok := (ioresult = 0);
  437.       dialarray_number := 0;
  438.       with dial_dir do begin
  439.          if ok then
  440.             read(dialfile,dial_dir)
  441.          else begin
  442.             no_of_dial_entries := 0;
  443.             rewrite(dialfile);
  444.             write(dialfile,dial_dir);
  445.             close(dialfile);
  446.             assign(dialfile,dial_PATH+'TMODEM.DIR');
  447.             reset(dialfile);
  448.             read(dialfile,dial_dir);
  449.          end;
  450.          directory_manager;
  451.          close(dialfile);
  452.       end;
  453.       rmwin;
  454.    end;
  455.  
  456. (****************************************************************************)
  457. (*                           HANG UP THE MODEM                              *)
  458. (****************************************************************************)
  459.    procedure
  460.       hang_up;
  461.    begin
  462.       mkwin(10,8,71,14,'');
  463.       gotoxy(23,3);
  464.       write('Hanging Up');
  465.       gotoxy(60,5);
  466.       port[modem_control_reg] := 0;
  467.       ascii_mode := false;
  468.       delay( a_second * 4 );
  469.       setserial(baud,stopbits,databits,par);
  470.       initialize_music;
  471.       flush_sin_buff;
  472.       sout_store_ptr := sout_read_ptr;
  473.       dial_str := modem_init_str;
  474.       dialer;
  475.       rmwin;
  476.       writeln;
  477.    end;
  478.  
  479. (****************************************************************************)
  480. (*                            REDIAL THE MODEM                              *)
  481. (****************************************************************************)
  482.    procedure
  483.       redial_modem;
  484.    var
  485.       m            : integer;
  486.       i,j          : integer;
  487.       dt           : integer;
  488.       stop_dialing : boolean;
  489.    begin
  490.       if redial_number = '' then exit;
  491.       mkwin(10,6,71,16,'');
  492.       if forced_carrier[1] = 'T' then begin
  493.          gotoxy(26,3);
  494.          write('Redialing');
  495.       end
  496.       else begin
  497.          gotoxy(18,3);
  498.          write('Redialing Every ',redial_time,' Seconds');
  499.       end;
  500.       m := ( 60 - length( redial_name ) ) div 2 + 1;
  501.       gotoxy(m,5);
  502.       write( redial_name );
  503.       gotoxy(16,9);
  504.       write('Press any key to stop dialing... ');
  505.       dt := a_second div 20;
  506.       if forced_carrier[1] = 'T' then
  507.          stop_dialing := true
  508.       else begin
  509.          stop_dialing := false;
  510.          dial_str := speaker_off;
  511.          dialer;
  512.       end;
  513.       delay( a_second );
  514.       initialize_music;
  515.       dial_str := redial_number;
  516.       repeat
  517.          dialer;
  518.          dial_time := time;
  519.          i := redial_time + succ(carrier_timeout);
  520.          while ( i > 1 ) and ( not stop_dialing ) do begin
  521.             i := pred( i );
  522.             gotoxy(55,9);
  523.             if i <= redial_time then
  524.                write(i:4)
  525.             else
  526.                clreol;
  527.             j := 0;
  528.             while ( j < 20 ) and ( not stop_dialing ) do begin
  529.                j := succ( j );
  530.                if keypressed then begin
  531.                   stop_dialing := true;
  532.                   read(kbd,kbd_char);
  533.                   store_sout_buffer(' ');
  534.                   delay( a_second );
  535.                   flush_sin_buff;
  536.                end;
  537.                if ( port[modem_status_reg] and $80 ) <> 0 then begin
  538.                   delay( a_second );
  539.                   rmwin;
  540.                   flush_sin_buff;
  541.                   writeln(CR+'CONNECT'^G);
  542.                   exit;
  543.                end
  544.                else
  545.                   delay( dt );
  546.             end;
  547.          end;
  548.       until stop_dialing;
  549.       rmwin;
  550.    end;
  551.  
  552. (****************************************************************************)
  553. (*                        ASCII FILE TRANSMISSION                           *)
  554. (****************************************************************************)
  555.    procedure
  556.       ascii_transmission;
  557.    var
  558.       image_cnt   : integer;
  559.    begin
  560.       mkwin(15,4,62,13,'Transmit ASCII File');
  561.       image_cnt := 0;
  562.       continue_transfer := true;
  563.       repeat
  564.          write(' Enter Filename to Transmit: ');
  565.          readln(filename);
  566.          if length(filename)=0 then begin
  567.             rmwin;
  568.             exit;
  569.          end;
  570.          assign(textfile,filename);
  571.          {$I-}
  572.          reset(textfile);
  573.          {$I+}
  574.          ok:=(ioresult = 0);
  575.          if not ok then
  576.             writeln(' Cannot find file: ',filename);
  577.       until ok;
  578.       ascii_mode := true;
  579.       gotoxy(1,2);
  580.       clreol;
  581.       writeln;
  582.       writeln('             Lines Transmitted');
  583.       writeln('             -----------------');
  584.       clreol;
  585.       while ( not eof(textfile) ) and continue_transfer do begin
  586.          readln(textfile,textimage);
  587.          image_cnt := succ(image_cnt);
  588.          gotoxy(19,5);
  589.          writeln(image_cnt:5);
  590.          xmit_data(textimage+CRLF);
  591.       end;
  592.       xmit_data(^Z^K);
  593.       close(textfile);
  594.       writeln;
  595.       write(' Waiting for buffer to drain...');
  596.       repeat until sout_store_ptr = sout_read_ptr;
  597.       ascii_mode := false;
  598.       flush_sin_buff;
  599.       rmwin;
  600.    end;
  601.  
  602. (****************************************************************************)
  603. (*                               VIEW FILE                                  *)
  604. (****************************************************************************)
  605.    procedure
  606.       view_file;
  607.    var
  608.       cnt       : byte;
  609.       wlabel    : labeltype;
  610.    begin
  611.       mkwin(33,4,77,10,'View File');
  612.       gotoxy(1,3);
  613.       repeat
  614.          write(' Enter Filename to View: ');
  615.          readln(filename);
  616.          if length(filename)=0 then begin
  617.             rmwin;
  618.             exit;
  619.          end;
  620.          assign(textfile,filename);
  621.          {$I-}
  622.          reset(textfile);
  623.          {$I+}
  624.          ok:=(ioresult = 0);
  625.          if not ok then
  626.             writeln(' Cannot find file: ',filename);
  627.       until ok;
  628.       rmwin;
  629.       wlabel := 'View File [' + filename + '],  <End> To Stop.';
  630.       mkwin(1,1,80,24,wlabel);
  631.       cnt := -5;
  632.       a_key := ' ';
  633.       while ( not eof(textfile) )
  634.          and  ( a_key[1] <> #207 )
  635.       do begin
  636.          readln(textfile,textimage);
  637.          if length(textimage) <= 77 then
  638.             writeln(textimage)
  639.          else
  640.             write(copy(textimage,1,78));
  641.          cnt := succ(cnt);
  642.          if cnt = 16 then begin
  643.             cnt:=0;
  644.             write(' <<< MORE >>> ');
  645.             repeat
  646.                a_key := inkey;
  647.             until a_key <> '';
  648.             if length(a_key)>1 then
  649.                a_key := chr(ord(a_key[2])+128);
  650.             gotoxy(1,wherey);
  651.             clreol;
  652.          end;
  653.       end;
  654.       close(textfile);
  655.       if ( cnt > 0 )
  656.          and ( a_key[1] <> #207 )
  657.       then begin
  658.          writeln;
  659.          wait_for_key;
  660.       end;
  661.       rmwin;
  662.    end;
  663.  
  664. (****************************************************************************)
  665. (*                              PRINT FILE                                  *)
  666. (****************************************************************************)
  667.    procedure
  668.       page_heading;
  669.    var
  670.       i : byte;
  671.    begin
  672.       for i:=1 to 3 do writeln(lst);
  673.    end;
  674.  
  675.    procedure
  676.       print_file;
  677.    var
  678.       cnt       : byte;
  679.    begin
  680.       mkwin(33,4,77,10,'Print File');
  681.       gotoxy(1,3);
  682.       repeat
  683.          write(' Enter Filename to Print: ');
  684.          readln(filename);
  685.          if length(filename)=0 then begin
  686.             rmwin;
  687.             exit;
  688.          end;
  689.          assign(textfile,filename);
  690.          {$I-}
  691.          reset(textfile);
  692.          {$I+}
  693.          ok:=(ioresult = 0);
  694.          if not ok then
  695.             writeln(' Cannot find file: ',filename);
  696.       until ok;
  697.       writeln;
  698.       writeln(' Make Printer Ready.');
  699.       wait_for_key;
  700.       writeln;
  701.       writeln;
  702.       write(' Printing... ');
  703.       cnt := 0;
  704.       page_heading;
  705.       while not eof(textfile) do begin
  706.          readln(textfile,textimage);
  707.          writeln(lst,textimage);
  708.          cnt := succ(cnt);
  709.          if cnt = 60 then begin
  710.             cnt:=0;
  711.             write(lst,FF);
  712.             page_heading;
  713.          end;
  714.       end;
  715.       close(textfile);
  716.       write(lst,FF);
  717.       rmwin;
  718.    end;
  719.  
  720. (****************************************************************************)
  721. (*                       ENTER / LEAVE  HALF DUPLEX                         *)
  722. (****************************************************************************)
  723.    procedure
  724.       toggle_duplex;
  725.    begin
  726.       if half_duplex then begin
  727.          half_duplex := false;
  728.          clear_pos(79,25);
  729.       end
  730.       else begin
  731.          escape_win;
  732.          half_duplex := true;
  733.          gotoxy(79,25);
  734.          write('H');
  735.          reset_win;
  736.       end;
  737.    end;
  738.  
  739. (****************************************************************************)
  740. (*                      CHANGE DIRECTORY AND DISK DRIVE                     *)
  741. (****************************************************************************)
  742.    procedure
  743.       new_directory_drive;
  744.    var
  745.       dd     : char;
  746.       dn     : integer;
  747.       curdir : string40;
  748.       dstr   : string10;
  749.    begin
  750.       mkwin(12,4,69,12,'Change Directory\Drive');
  751.       dd:=default_drive;
  752.       dn:=ord(dd) - pred( ord('A') );
  753.       getdir(dn,curdir);
  754.       writeln;
  755.       writeln(' Current Drive\Directory: ',curdir);
  756.       writeln;
  757.       write(' Enter New Drive Letter : ');
  758.       readln(dstr);
  759.       if length(dstr)>0 then begin
  760.          dd:=upcase(dstr[1]);
  761.          if not (dd in [ 'A'..'D' ]) then
  762.             dd:='A';
  763.          change_drive(dd);
  764.       end;
  765.       repeat
  766.          write('     Enter New Directory: ');
  767.          readln(curdir);
  768.          {$I-}
  769.          if length(curdir)>0 then begin
  770.             chdir(curdir);
  771.             ok:=(ioresult = 0);
  772.             if not ok then
  773.                writeln(' Can''t access that directory!');
  774.          end;
  775.          {$I+}
  776.       until ( ok )  or  ( length( curdir ) = 0 );
  777.       rmwin;
  778.    end;
  779.  
  780. (****************************************************************************)
  781. (*                               KILL FILE                                  *)
  782. (****************************************************************************)
  783.    procedure
  784.       kill_file;
  785.    begin
  786.       mkwin(33,4,77,10,'Kill File');
  787.       gotoxy(1,3);
  788.       repeat
  789.          write(' Enter Filename to Kill: ');
  790.          readln(filename);
  791.          if length(filename)=0 then begin
  792.             rmwin;
  793.             exit;
  794.          end;
  795.          assign(textfile,filename);
  796.          {$I-}
  797.          erase(textfile);
  798.          {$I+}
  799.          ok:=(ioresult = 0);
  800.          if not ok then
  801.             writeln(' Cannot kill file: ',filename);
  802.       until ok;
  803.       rmwin;
  804.    end;
  805.  
  806. (****************************************************************************)
  807. (*                         REWRITE DIAL ENTRIES                             *)
  808. (****************************************************************************)
  809.    procedure
  810.       rewrite_dial_entries;
  811.    begin
  812.       rewrite(dialfile);
  813.       sort_curr := sort_first;
  814.       dial_dir.no_of_dial_entries := 0;
  815.       while sort_curr <> nil do begin
  816.          dial_dir.no_of_dial_entries := succ(dial_dir.no_of_dial_entries);
  817.          dial_dir.dir_entries[dial_dir.no_of_dial_entries] := sort_curr^.sort_rec;
  818.          if dial_dir.no_of_dial_entries = max_dial_entries then begin
  819.             write(dialfile,dial_dir);
  820.             dial_dir.no_of_dial_entries := 0;
  821.          end;
  822.          sort_first := sort_curr;
  823.          sort_curr := sort_curr^.sort_next;
  824.          dispose(sort_first);
  825.       end;
  826.       if dial_dir.no_of_dial_entries > 0 then
  827.          write(dialfile,dial_dir);
  828.    end;
  829.  
  830. (****************************************************************************)
  831. (*                           SORT DIAL ENTRIES                              *)
  832. (****************************************************************************)
  833.    procedure
  834.       sort_dial_entries( typ : integer );
  835.    var
  836.       flg      : boolean;
  837.       hold_rec : dialrec;
  838.       swap     : boolean;
  839.    begin
  840.       repeat
  841.          flg := false;
  842.          sort_curr := sort_first;
  843.          sort_prev := sort_curr^.sort_next;
  844.          while sort_prev <> nil do begin
  845.             swap := false;
  846.             case typ of
  847.                1 : begin
  848.                       if sort_curr^.sort_rec.bbs_name > sort_prev^.sort_rec.bbs_name then
  849.                          swap := true;
  850.                    end;
  851.                2 : begin
  852.                       if sort_curr^.sort_rec.bbs_number > sort_prev^.sort_rec.bbs_number then
  853.                          swap := true;
  854.                    end;
  855.             end;
  856.             if swap then begin
  857.                flg := true;
  858.                hold_rec := sort_prev^.sort_rec;
  859.                sort_prev^.sort_rec := sort_curr^.sort_rec;
  860.                sort_curr^.sort_rec := hold_rec;
  861.             end;
  862.             sort_curr := sort_curr^.sort_next;
  863.             sort_prev := sort_prev^.sort_next;
  864.          end;
  865.       until not flg;
  866.    end;
  867.  
  868. (****************************************************************************)
  869. (*                           LOAD DIAL ENTRIES                              *)
  870. (****************************************************************************)
  871.    procedure
  872.       load_dial_entries( fs  :  integer );
  873.    var
  874.       i,j   : integer;
  875.    begin
  876.       new(sort_first);
  877.       sort_curr := sort_first;
  878.       for i:=0 to fs do begin
  879.          seek(dialfile,i);
  880.          read(dialfile,dial_dir);
  881.          for j:=1 to dial_dir.no_of_dial_entries do begin
  882.             sort_curr^.sort_rec := dial_dir.dir_entries[j];
  883.             new(sort_curr^.sort_next);
  884.             sort_prev := sort_curr;
  885.             sort_curr := sort_curr^.sort_next;
  886.          end;
  887.       end;
  888.       dispose(sort_curr);
  889.       sort_prev^.sort_next := nil;
  890.    end;
  891.  
  892. (****************************************************************************)
  893. (*                         SORT DIALING DIRECTORY                           *)
  894. (****************************************************************************)
  895.    procedure
  896.       sort_dialing_directory;
  897.    var
  898.       fsize   : integer;
  899.       typ     : integer;
  900.    begin
  901.       mkwin(8,4,73,12,'Phone Directory Sort Type');
  902.       gotoxy(10,2);
  903.       write('1.  Sort Into Ascending Sequence By Name.');
  904.       gotoxy(10,4);
  905.       write('2.  Sort Into Ascending Sequence By Number.');
  906.       gotoxy(10,7);
  907.       write('Which do you want? ');
  908.       typ := 0;
  909.       read(typ);
  910.       if not (typ in [ 1..2 ]) then
  911.          typ := 1;
  912.       rmwin;
  913.       mkwin(10,5,71,11,'');
  914.       gotoxy(23,3);
  915.       write('S O R T I N G ');
  916.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  917.       {$I-}
  918.       reset(dialfile);
  919.       {$I+}
  920.       ok := (ioresult = 0);
  921.       if ok then begin
  922.          fsize := filesize(dialfile);
  923.          if fsize > 0 then begin
  924.             load_dial_entries( pred(fsize) );
  925.             sort_dial_entries(typ);
  926.             rewrite_dial_entries;
  927.             close(dialfile);
  928.          end;
  929.       end;
  930.       rmwin;
  931.    end;
  932.  
  933. (****************************************************************************)
  934. (*                             SEND FUNCTION KEY                            *)
  935. (****************************************************************************)
  936.    procedure
  937.       send_func_key( j : integer );
  938.    var
  939.       i             : byte;
  940.       c             : char;
  941.    begin
  942.       i := 0;
  943.       while i < length(func_key^[j]) do begin
  944.          i := succ( i );
  945.          c := func_key^[j][i];
  946.          if c = comment_ch then
  947.             exit;
  948.          case c of
  949.             '|' : store_sout_buffer( CR );
  950.             '~' : delay( a_second );
  951.          else
  952.             store_sout_buffer( c );
  953.          end;
  954.       end;
  955.    end;
  956.  
  957. (****************************************************************************)
  958. (*                           MACRO KEY MAINTENANCE                          *)
  959. (****************************************************************************)
  960.    procedure
  961.       display_keys( Fn : integer );
  962.    var
  963.       i    : byte;
  964.    begin
  965.       gotoxy(2,2);
  966.       clreol;
  967.       case Fn of
  968.           1 : writeln('< Unshifted >');
  969.          11 : writeln('< Shifted >');
  970.          21 : writeln('< Ctrl >');
  971.          31 : writeln('< Alt >');
  972.       end;
  973.       writeln;
  974.       for i:=1 to 10 do begin
  975.          clreol;
  976.          writeln(i:3,'.  ',func_key^[i+Fn-1]);
  977.       end;
  978.    end;
  979.  
  980.    procedure
  981.       page_func_fwd(var Fn : integer);
  982.    begin
  983.       Fn := Fn + 10;
  984.       if Fn > 40 then Fn := Fn - 40;
  985.       display_keys(Fn);
  986.    end;
  987.  
  988.    procedure
  989.       page_func_bak(var Fn : integer);
  990.    begin
  991.       Fn := Fn - 10;
  992.       if Fn < 1 then Fn := Fn + 40;
  993.       display_keys(Fn);
  994.    end;
  995.  
  996.    procedure
  997.       macro_keys;
  998.    var
  999.       i      : integer;
  1000.       flg    : boolean;
  1001.       Fn     : integer;
  1002.    begin
  1003.       flg := false;
  1004.       mkwin(1,3,80,20,'Function Keys. Use:  | for CR,  ~ for delay,  '+comment_ch+' for comment.');
  1005.       Fn := 1;
  1006.       display_keys(Fn);
  1007.       gotoxy(1,16);
  1008.       write(' Enter: C=Chg, F=PgFwd, B=PgBak, Q=Quit. ');
  1009.       repeat
  1010.          gotoxy(42,16);
  1011.          clreol;
  1012.          repeat
  1013.             a_key := inkey;
  1014.          until a_key <> '';
  1015.          kbd_char := upcase( a_key[1] );
  1016.          case kbd_char of
  1017.             'C' : begin
  1018.                      write(' Which One? ');
  1019.                      read(i);
  1020.                      if ( i > 0 ) and ( i < 11 ) then begin
  1021.                         flg := true;
  1022.                         gotoxy(7,i+3);
  1023.                         str_input(func_key^[i+Fn-1]);
  1024.                      end;
  1025.                   end;
  1026.             'F' : page_func_fwd(Fn);
  1027.             'B' : page_func_bak(Fn);
  1028.          end;
  1029.       until kbd_char = 'Q';
  1030.       if flg then begin
  1031.          assign(textfile,cnf_PATH+'TMODEM.KEY');
  1032.          rewrite(textfile);
  1033.          for i:=1 to 40 do writeln(textfile,func_key^[i]);
  1034.          close(textfile);
  1035.       end;
  1036.       rmwin;
  1037.    end;
  1038.  
  1039. (****************************************************************************)
  1040. (*                          EXECUTE KEYBOARD COMMAND                        *)
  1041. (****************************************************************************)
  1042.    procedure
  1043.       underscore;
  1044.    begin
  1045.       gotoxy(13,wherey);
  1046.       write('--------');
  1047.       gotoxy(24,wherey);
  1048.       writeln('--------');
  1049.    end;
  1050.    procedure
  1051.       exec_command;
  1052.    begin
  1053.       case ch of
  1054.          #46  : toggle_capture_mode;
  1055.          #20  : begin
  1056.                    mkwin(57,18,78,22,'');
  1057.                    writeln;
  1058.                    write(' Exit Program? ');
  1059.                    yes_no := ' ';
  1060.                    readln(yes_no);
  1061.                    yes_no := upcase( yes_no[1] );
  1062.                    if yes_no = 'Y' then exit_program := true;
  1063.                    rmwin;
  1064.                 end;
  1065.          #31  : change_comm_params;
  1066.          #19  : receive_file;
  1067.          #45  : transmit_file;
  1068.          #32  : dial_modem;
  1069.          #18  : toggle_duplex;
  1070.          #35  : give_help;
  1071.          #23  : reconfigure_defaults;
  1072.          #30  : ascii_transmission;
  1073.          #16  : hang_up;
  1074.          #38  : dir_list;
  1075.          #49  : new_directory_drive;
  1076.          #47  : view_file;
  1077.          #37  : kill_file;
  1078.          #34  : redial_modem;
  1079.          #50  : macro_keys;
  1080.          #24  : sort_dialing_directory;
  1081.          #17  : begin
  1082.                    if split_screen[1]='T' then
  1083.                       setup_split
  1084.                    else
  1085.                       clrscr;
  1086.                 end;
  1087.          #21  : copy_file;
  1088.          #25  : print_file;
  1089.          #71  : send_str( ^['[H' );          { Home Key    }
  1090.          #82  : send_str( ^['On' );          { Ins Key     }
  1091.          #72  : begin
  1092.                    if keypad_mode then
  1093.                       send_str( ^['OA' )
  1094.                    else
  1095.                       send_str( ^['[A' );
  1096.                 end;
  1097.          #80  : begin
  1098.                    if keypad_mode then
  1099.                       send_str( ^['OB' )
  1100.                    else
  1101.                       send_str( ^['[B' );
  1102.                 end;
  1103.          #77  : begin
  1104.                    if keypad_mode then
  1105.                       send_str( ^['OC' )
  1106.                    else
  1107.                       send_str( ^['[C' );
  1108.                 end;
  1109.          #75  : begin
  1110.                    if keypad_mode then
  1111.                       send_str( ^['OD' )
  1112.                    else
  1113.                       send_str( ^['[D' );
  1114.                 end;
  1115.          #117 : send_str( ^['OS' );          { ^End }
  1116.          #79  : send_str( ^['OR' );          { End  }
  1117.          #73  : send_str( ^['Or' );          { PgUp }
  1118.          #81  : send_str( ^['Oq' );          { PgDn }
  1119.          #15  : send_str( ^['Ox' );          { Shift Tab }
  1120.          #83  : store_sout_buffer( DEL );
  1121.          #44  : begin
  1122.                    if monitor_mode then
  1123.                       monitor_mode := false
  1124.                    else
  1125.                       monitor_mode := true;
  1126.                 end;
  1127.          #114 : begin
  1128.                    if printer_on then
  1129.                       printer_on:=false
  1130.                    else
  1131.                       printer_on:=true;
  1132.                 end;
  1133.          #33  : begin
  1134.                    time_fix := time+' ';
  1135.                    writeln(CRLF+'Time Fix :  ',time_fix);
  1136.                 end;
  1137.          #22  : begin
  1138.                    writeln;
  1139.                    gotoxy(13,wherey);
  1140.                    write('Time Fix');
  1141.                    gotoxy(24,wherey);
  1142.                    writeln('Session');
  1143.                    underscore;
  1144.                    write('Starting :  ',time_fix);
  1145.                    gotoxy(24,wherey);
  1146.                    writeln(dial_time);
  1147.                    curr_time := time+' ';
  1148.                    write('Current  :  ',curr_time);
  1149.                    gotoxy(24,wherey);
  1150.                    writeln(curr_time);
  1151.                    underscore;
  1152.                    write('Used     :  ',delta_time(time_fix,curr_time));
  1153.                    gotoxy(24,wherey);
  1154.                    writeln(delta_time(dial_time,curr_time));
  1155.                 end;
  1156.          #48  : begin             { Send Break }
  1157.                    mkwin(15,8,66,14,'');
  1158.                    gotoxy(21,3);
  1159.                    write('Break');
  1160.                    gotoxy(50,5);
  1161.                    port[line_control_reg] := port[line_control_reg] or $40;
  1162.                    delay( wait_increment );
  1163.                    port[line_control_reg] := port[line_control_reg] and $BF;
  1164.                    rmwin;
  1165.                 end;
  1166.          #36  : begin;            { ID Program }
  1167.                    mkwin(15,8,66,14,'TMODEM, ver '+version);
  1168.                    gotoxy(10,3);
  1169.                    wait_for_key;
  1170.                    rmwin;
  1171.                 end;
  1172.       else
  1173.          if ch in [ #59..#68 ] then
  1174.             send_func_key( ord(ch) - 58 )
  1175.          else
  1176.             if ch in [ #84..#113 ] then
  1177.                send_func_key( ord(ch) - 73 );
  1178.       end;
  1179.    end;
  1180.