home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TMODEM.ZIP / TMODEM.IN2 < prev    next >
Encoding:
Text File  |  1987-06-16  |  28.4 KB  |  918 lines
  1. (****************************************************************************)
  2. (*                   CHANGE COMMUNICATION PARAMETERS                        *)
  3. (****************************************************************************)
  4.    procedure
  5.       change_comm_params;
  6.    begin
  7.       mkwin(16,7,61,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.       else
  15.          ;
  16.       end;
  17.       writeln(databits:2,stopbits:2);
  18.       writeln;
  19.       writeln('    Enter New Parameters.');
  20.       writeln('    ---------------------');
  21.       write('    Baud Rate, 300, 1200 or 2400  : ');
  22.       readln(baud_ch);
  23.       if length(baud_ch)>0 then begin
  24.         baud:=bval(baud_ch);
  25.          case baud of
  26.             300  : ;
  27.             1200 : ;
  28.             2400 : ;
  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,paritytype(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.                   else
  102.                      ;
  103.                   end;
  104.                   write(bbs_databits,' ',bbs_stopbits);
  105.                end;
  106.             end;
  107.          end;
  108.          writeln;
  109.       end;
  110.    end;
  111.  
  112. (****************************************************************************)
  113. (*                          GET DIRECTORY INFO                              *)
  114. (****************************************************************************)
  115.    procedure
  116.       get_info(i  :  integer);
  117.    var
  118.       entry_no    : integer;
  119.    begin
  120.       entry_no := i - 3;
  121.       with dial_dir.dir_entries[entry_no] do begin
  122.          gotoxy(5,i);
  123.          input(bbs_name);
  124.          gotoxy(36,i);
  125.          input(bbs_number);
  126.          gotoxy(67,i);
  127.          if bbs_baud = 0 then begin
  128.             baud_ch := '';
  129.             parity_ch := '';
  130.             data_ch := '';
  131.             stop_ch := '';
  132.          end
  133.          else begin
  134.             str(bbs_baud:4,baud_ch);
  135.             case bbs_parity of
  136.                0 : parity_ch := 'N';
  137.                1 : parity_ch := 'E';
  138.                2 : parity_ch := 'O';
  139.             else
  140.                parity_ch := ' ';
  141.             end;
  142.             str(bbs_databits:1,data_ch);
  143.             str(bbs_stopbits:1,stop_ch);
  144.          end;
  145.          input(baud_ch);
  146.          bbs_baud := bval(baud_ch);
  147.          case bbs_baud of
  148.             300  : ;
  149.             1200 : ;
  150.             2400 : ;
  151.          else
  152.             bbs_baud := default_baud;
  153.          end;
  154.          gotoxy(72,i);
  155.          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.          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.          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.          gotoxy(75,21);
  184.       end;
  185.    end;
  186.  
  187. (****************************************************************************)
  188. (*                          ADD DIRECTORY ENTRY                             *)
  189. (****************************************************************************)
  190.    procedure
  191.       add_dial_entry;
  192.    var
  193.       row    : integer;
  194.       ch     : char;
  195.    begin
  196.       with dial_dir do begin
  197.          while no_of_dial_entries = max_dial_entries do begin
  198.             dialarray_number := dialarray_number + 1;
  199.             {$I-}
  200.             seek(dialfile,dialarray_number);
  201.             read(dialfile,dial_dir);
  202.             {$I+}
  203.             ok := (ioresult=0);
  204.             if not ok then begin
  205.                seek(dialfile,dialarray_number);
  206.                no_of_dial_entries := 0;
  207.                write(dialfile,dial_dir);
  208.             end;
  209.          end;
  210.          paint_directory_screen(1);
  211.          no_of_dial_entries := no_of_dial_entries + 1;
  212.          row := no_of_dial_entries + 3;
  213.          with dir_entries[no_of_dial_entries] do begin
  214.             bbs_name := '';
  215.             bbs_number := '';
  216.             bbs_baud := 0;
  217.             bbs_parity := 0;
  218.             bbs_databits := 8;
  219.             bbs_stopbits := 1;
  220.          end;
  221.          get_info(row);
  222.          seek(dialfile,dialarray_number);
  223.          write(dialfile,dial_dir);
  224.       end;
  225.    end;
  226.  
  227. (****************************************************************************)
  228. (*                        CHANGE DIRECTORY ENTRY                            *)
  229. (****************************************************************************)
  230.    procedure
  231.       change_dial_entry;
  232.    var
  233.       i   : integer;
  234.       row : integer;
  235.    begin
  236.       mkwin(41,1,71,5,'Update');
  237.       writeln;
  238.       write(' Enter the # to change: ');
  239.       readln(i);
  240.       rmwin;
  241.       i := i - (dialarray_number * max_dial_entries);
  242.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  243.          row := i + 3;
  244.          get_info(row);
  245.          seek(dialfile,dialarray_number);
  246.          write(dialfile,dial_dir);
  247.       end;
  248.    end;
  249.  
  250. (****************************************************************************)
  251. (*                         DELETE DIRECTORY ENTRY                           *)
  252. (****************************************************************************)
  253.    procedure
  254.       delete_dial_entry;
  255.    var
  256.       i    : integer;
  257.       j    : integer;
  258.    begin
  259.       mkwin(41,1,71,5,'Delete');
  260.       writeln;
  261.       write(' Enter the # to delete: ');
  262.       readln(i);
  263.       rmwin;
  264.       j := i - (dialarray_number * max_dial_entries);
  265.       i := j;
  266.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  267.          with dial_dir do begin
  268.             while i < no_of_dial_entries do begin
  269.                dir_entries[i] := dir_entries[i+1];
  270.                i := i + 1;
  271.             end;
  272.             no_of_dial_entries := no_of_dial_entries - 1;
  273.             paint_directory_screen(j);
  274.             seek(dialfile,dialarray_number);
  275.             write(dialfile,dial_dir);
  276.          end;
  277.       end;
  278.       gotoxy(75,21);
  279.    end;
  280.  
  281. (****************************************************************************)
  282. (*                                DIALER                                    *)
  283. (****************************************************************************)
  284.    procedure
  285.       dialer;
  286.    var
  287.       i  : integer;
  288.    begin
  289.       for i:=1 to length(dial_str) do begin
  290.          store_sout_buffer(dial_str[i]);
  291.       end;
  292.    end;
  293.  
  294. (****************************************************************************)
  295. (*                           MANUAL DIAL MODEM                              *)
  296. (****************************************************************************)
  297.    procedure
  298.       manual_dial;
  299.    begin
  300.       mkwin(25,1,71,5,'Manual Dial');
  301.       writeln;
  302.       write(' Enter Phone Number: ');
  303.       readln(dial_str);
  304.       dial_str := dial_pre_str + dial_str + dial_post_str;
  305.       change_comm_params;
  306.       dialer;
  307.       rmwin;
  308.    end;
  309.  
  310. (****************************************************************************)
  311. (*                            AUTO DIAL MODEM                               *)
  312. (****************************************************************************)
  313.    procedure
  314.       auto_dial;
  315.    var
  316.       i        : integer;
  317.    begin
  318.       mkwin(41,1,71,5,'Auto Dial');
  319.       writeln;
  320.       write(' Enter the # to dial: ');
  321.       readln(i);
  322.       i := i - (dialarray_number * max_dial_entries);
  323.       if ( I > 0 ) and ( i <= max_dial_entries ) then begin
  324.          with dial_dir.dir_entries[i] do begin
  325.             baud := bbs_baud;
  326.             stopbits := bbs_stopbits;
  327.             databits := bbs_databits;
  328.             par := bbs_parity;
  329.             setserial(baud,stopbits,databits,paritytype(par));
  330.             dial_str := dial_pre_str + bbs_number + dial_post_str;
  331.             dialer;
  332.          end;
  333.       end
  334.       else begin
  335.          writeln(' Number must be on screen.');
  336.          wait_for_key;
  337.       end;
  338.       rmwin;
  339.    end;
  340.  
  341. (****************************************************************************)
  342. (*                             PAGE FORWARD                                 *)
  343. (****************************************************************************)
  344.    procedure
  345.       page_forward;
  346.    var
  347.       fsize : integer;
  348.    begin
  349.       fsize := filesize(dialfile) - 1;
  350.       if dialarray_number = fsize then exit;
  351.       dialarray_number := dialarray_number + 1;
  352.       seek(dialfile,dialarray_number);
  353.       read(dialfile,dial_dir);
  354.       paint_directory_screen(1);
  355.       gotoxy(75,21);
  356.    end;
  357.  
  358. (****************************************************************************)
  359. (*                             PAGE BACKWARD                                *)
  360. (****************************************************************************)
  361.    procedure
  362.       page_backward;
  363.    begin
  364.       if dialarray_number = 0 then exit;
  365.       dialarray_number := dialarray_number - 1;
  366.       seek(dialfile,dialarray_number);
  367.       read(dialfile,dial_dir);
  368.       paint_directory_screen(1);
  369.       gotoxy(75,21);
  370.    end;
  371.  
  372. (****************************************************************************)
  373. (*                           DIRECTORY MANAGER                              *)
  374. (****************************************************************************)
  375.    procedure
  376.       directory_manager;
  377.    begin
  378.       writeln('                           Phone Directory');
  379.       writeln('  #         BBS Name                     Phone Number             Baud P D S');
  380.       writeln(' -- ------------------------------ ------------------------------ ---- - - -');
  381.       paint_directory_screen(1);
  382.       writeln;
  383.       write('A=Add, C=Chg, D=Del, M=M.Dial, G=A.Dial, S=Stop, F=PgFwd, B=PgBak, Q=Quit ');
  384.       repeat
  385.          repeat until keypressed;
  386.          read(kbd,kbd_char);
  387.          kbd_char := upcase(kbd_char);
  388.          case kbd_char of
  389.             'A' : add_dial_entry;
  390.             'C' : change_dial_entry;
  391.             'D' : delete_dial_entry;
  392.             'M' : manual_dial;
  393.             'G' : auto_dial;
  394.             'S' : store_sout_buffer(' ');
  395.             'F' : page_forward;
  396.             'B' : page_backward;
  397.             'Q' : ;
  398.          else
  399.             ;
  400.          end;
  401.       until kbd_char = 'Q';
  402.    end;
  403.  
  404. (****************************************************************************)
  405. (*                             MODEM DIALER                                 *)
  406. (****************************************************************************)
  407.    procedure
  408.       dial_modem;
  409.    begin
  410.       mkwin(1,1,80,23,'');
  411.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  412.       {$I-};
  413.       reset(dialfile);
  414.       {$I+}
  415.       ok := (ioresult = 0);
  416.       dialarray_number := 0;
  417.       with dial_dir do begin
  418.          if ok then
  419.             read(dialfile,dial_dir)
  420.          else begin
  421.             no_of_dial_entries := 0;
  422.             rewrite(dialfile);
  423.             write(dialfile,dial_dir);
  424.             close(dialfile);
  425.             assign(dialfile,dial_PATH+'TMODEM.DIR');
  426.             reset(dialfile);
  427.             read(dialfile,dial_dir);
  428.          end;
  429.          directory_manager;
  430.          close(dialfile);
  431.       end;
  432.       rmwin;
  433.    end;
  434.  
  435. (****************************************************************************)
  436. (*                           HANG UP THE MODEM                              *)
  437. (****************************************************************************)
  438.    procedure
  439.       hang_up;
  440.    begin
  441.       mkwin(10,8,71,14,'');
  442.       gotoxy(23,3);
  443.       write('Hanging Up');
  444.       gotoxy(60,5);
  445.       port[int_enable_reg] := 0;                 { Complete reset of modem }
  446.       port[modem_control_reg] := 0;              { control circuitry and   }
  447.       port[$21] := port[$21] or turn_IRQ_off;    { associated pointers.    }
  448.       sin_store_ptr := 1;
  449.       sin_read_ptr := 1;
  450.       sout_store_ptr := 1;
  451.       sout_read_ptr := 1;
  452.       ascii_mode := false;
  453.       delay( wait_increment * 10 );
  454.       setserial(baud,stopbits,databits,paritytype(par));
  455.       dial_str := modem_init_str;
  456.       dialer;
  457.       dial_str := '';
  458.       rmwin;
  459.    end;
  460.  
  461. (****************************************************************************)
  462. (*                            REDIAL THE MODEM                              *)
  463. (****************************************************************************)
  464.    procedure
  465.       redial_modem;
  466.    begin
  467.       mkwin(10,8,71,14,'');
  468.       gotoxy(24,3);
  469.       write('Redialing');
  470.       gotoxy(60,5);
  471.       dialer;
  472.       delay( wait_increment * 5 );
  473.       rmwin;
  474.    end;
  475.  
  476. (****************************************************************************)
  477. (*                        ASCII FILE TRANSMISSION                           *)
  478. (****************************************************************************)
  479.    procedure
  480.       ascii_transmission;
  481.    var
  482.       image_cnt   : integer;
  483.    begin
  484.       mkwin(15,4,62,13,'Transmit ASCII File');
  485.       image_cnt := 0;
  486.       continue_transfer := true;
  487.       repeat
  488.          write(' Enter Filename to Transmit: ');
  489.          readln(filename);
  490.          if length(filename)=0 then begin
  491.             rmwin;
  492.             exit;
  493.          end;
  494.          assign(textfile,filename);
  495.          {$I-}
  496.          reset(textfile);
  497.          {$I+}
  498.          ok:=(ioresult = 0);
  499.          if not ok then
  500.             writeln(' Cannot find file: ',filename);
  501.       until ok;
  502.       ascii_mode := true;
  503.       gotoxy(1,2);
  504.       writeln('                              ');
  505.       writeln('             Lines Transmitted');
  506.       writeln('             -----------------');
  507.       writeln('                              ');
  508.       while ( not eof(textfile) ) and continue_transfer do begin
  509.          readln(textfile,textimage);
  510.          image_cnt := image_cnt + 1;
  511.          gotoxy(19,5);
  512.          writeln(image_cnt:5);
  513.          xmit_data(textimage+CRLF);
  514.       end;
  515.       xmit_data(^Z^K);
  516.       close(textfile);
  517.       writeln;
  518.       write(' Waiting for buffer to drain...');
  519.       repeat until sout_store_ptr = sout_read_ptr;
  520.       ascii_mode := false;
  521.       sin_read_ptr := sin_store_ptr;          { Flush the buffer! }
  522.       rmwin;
  523.    end;
  524.  
  525. (****************************************************************************)
  526. (*                               VIEW FILE                                  *)
  527. (****************************************************************************)
  528.    procedure
  529.       view_file;
  530.    var
  531.       cnt       : byte;
  532.       wlabel    : labeltype;
  533.    begin
  534.       mkwin(33,4,77,10,'View File');
  535.       writeln;
  536.       writeln;
  537.       repeat
  538.          write(' Enter Filename to View: ');
  539.          readln(filename);
  540.          if length(filename)=0 then begin
  541.             rmwin;
  542.             exit;
  543.          end;
  544.          assign(textfile,filename);
  545.          {$I-}
  546.          reset(textfile);
  547.          {$I+}
  548.          ok:=(ioresult = 0);
  549.          if not ok then
  550.             writeln(' Cannot find file: ',filename);
  551.       until ok;
  552.       rmwin;
  553.       wlabel := 'View File [' + filename + '],  ^C  To Stop.';
  554.       mkwin(1,1,80,24,wlabel);
  555.       cnt := -5;
  556.       a_key := ' ';
  557.       while ( not eof(textfile) )
  558.          and  ( a_key[1] <> ^C )
  559.             and ( a_key[1] <> chr(27) )
  560.       do begin
  561.          readln(textfile,textimage);
  562.          if length(textimage) <= 77 then
  563.             writeln(textimage)
  564.          else
  565.             write(copy(textimage,1,78));
  566.          cnt := cnt + 1;
  567.          if cnt = 16 then begin
  568.             cnt:=0;
  569.             write(' <<< MORE >>> ');
  570.             repeat
  571.                a_key := inkey;
  572.             until a_key <> '';
  573.             gotoxy(1,wherey);
  574.             clreol;
  575.          end;
  576.       end;
  577.       close(textfile);
  578.       if ( cnt > 0 )
  579.          and ( a_key[1] <> ^C )
  580.             and ( a_key[1] <> chr(27) )
  581.       then begin
  582.          writeln;
  583.          wait_for_key;
  584.       end;
  585.       rmwin;
  586.    end;
  587.  
  588. (****************************************************************************)
  589. (*                       ENTER / LEAVE  HALF DUPLEX                         *)
  590. (****************************************************************************)
  591.    procedure
  592.       toggle_duplex;
  593.    begin
  594.       if half_duplex then begin
  595.          half_duplex := false;
  596.          clear_pos(79,25);
  597.       end
  598.       else begin
  599.          escape_win;
  600.          half_duplex := true;
  601.          gotoxy(79,25);
  602.          write('H');
  603.          reset_win;
  604.       end;
  605.    end;
  606.  
  607. (****************************************************************************)
  608. (*                      CHANGE DIRECTORY AND DISK DRIVE                     *)
  609. (****************************************************************************)
  610.    procedure
  611.       new_directory_drive;
  612.    var
  613.       dd     : char;
  614.       dn     : integer;
  615.       curdir : strtype;
  616.       dstr   : string[10];
  617.    begin
  618.       mkwin(12,4,69,12,'Change Directory\Drive');
  619.       dd:=default_drive;
  620.       dn:=ord(dd)-ord('A')+1;
  621.       getdir(dn,curdir);
  622.       writeln;
  623.       writeln(' Current Drive\Directory: ',curdir);
  624.       writeln;
  625.       write(' Enter New Drive Letter : ');
  626.       readln(dstr);
  627.       if length(dstr)>0 then begin
  628.          dd:=upcase(dstr[1]);
  629.          if ( ord(dd) < ord('A') )  or  ( ord(dd) > ord('D') ) then
  630.             dd:='A';
  631.          change_drive(dd);
  632.       end;
  633.       repeat
  634.          write('     Enter New Directory: ');
  635.          readln(curdir);
  636.          {$I-}
  637.          if length(curdir)>0 then begin
  638.             chdir(curdir);
  639.             ok:=(ioresult = 0);
  640.             if not ok then
  641.                writeln(' Can''t access that directory!');
  642.          end;
  643.          {$I+}
  644.       until ( ok )  or  ( length(curdir) = 0 );
  645.       rmwin;
  646.    end;
  647.  
  648. (****************************************************************************)
  649. (*                               KILL FILE                                  *)
  650. (****************************************************************************)
  651.    procedure
  652.       kill_file;
  653.    begin
  654.       mkwin(33,4,77,10,'Kill File');
  655.       repeat
  656.          write(' Enter Filename to Kill: ');
  657.          readln(filename);
  658.          if length(filename)=0 then begin
  659.             rmwin;
  660.             exit;
  661.          end;
  662.          assign(textfile,filename);
  663.          {$I-}
  664.          erase(textfile);
  665.          {$I+}
  666.          ok:=(ioresult = 0);
  667.          if not ok then
  668.             writeln(' Cannot kill file: ',filename);
  669.       until ok;
  670.       rmwin;
  671.    end;
  672.  
  673. (****************************************************************************)
  674. (*                         REWRITE DIAL ENTRIES                             *)
  675. (****************************************************************************)
  676.    procedure
  677.       rewrite_dial_entries;
  678.    begin
  679.       rewrite(dialfile);
  680.       sort_curr := sort_first;
  681.       dial_dir.no_of_dial_entries := 0;
  682.       while sort_curr <> nil do begin
  683.          dial_dir.no_of_dial_entries := dial_dir.no_of_dial_entries + 1;
  684.          dial_dir.dir_entries[dial_dir.no_of_dial_entries] := sort_curr^.sort_rec;
  685.          if dial_dir.no_of_dial_entries = max_dial_entries then begin
  686.             write(dialfile,dial_dir);
  687.             dial_dir.no_of_dial_entries := 0;
  688.          end;
  689.          sort_first := sort_curr;
  690.          sort_curr := sort_curr^.sort_next;
  691.          dispose(sort_first);
  692.       end;
  693.       if dial_dir.no_of_dial_entries > 0 then
  694.          write(dialfile,dial_dir);
  695.    end;
  696.  
  697. (****************************************************************************)
  698. (*                           SORT DIAL ENTRIES                              *)
  699. (****************************************************************************)
  700.    procedure
  701.       sort_dial_entries;
  702.    var
  703.       flg      : boolean;
  704.       hold_rec : dialrec;
  705.    begin
  706.       repeat
  707.          flg := false;
  708.          sort_curr := sort_first;
  709.          sort_prev := sort_curr^.sort_next;
  710.          while sort_prev <> nil do begin
  711.             if sort_curr^.sort_rec.bbs_name > sort_prev^.sort_rec.bbs_name then
  712.             begin
  713.                flg := true;
  714.                hold_rec := sort_prev^.sort_rec;
  715.                sort_prev^.sort_rec := sort_curr^.sort_rec;
  716.                sort_curr^.sort_rec := hold_rec;
  717.             end;
  718.             sort_curr := sort_curr^.sort_next;
  719.             sort_prev := sort_prev^.sort_next;
  720.          end;
  721.       until not flg;
  722.    end;
  723.  
  724. (****************************************************************************)
  725. (*                           LOAD DIAL ENTRIES                              *)
  726. (****************************************************************************)
  727.    procedure
  728.       load_dial_entries( fs  :  integer );
  729.    var
  730.       i,j   : integer;
  731.    begin
  732.       new(sort_first);
  733.       sort_curr := sort_first;
  734.       for i:=0 to fs do begin
  735.          seek(dialfile,i);
  736.          read(dialfile,dial_dir);
  737.          for j:=1 to dial_dir.no_of_dial_entries do begin
  738.             sort_curr^.sort_rec := dial_dir.dir_entries[j];
  739.             new(sort_curr^.sort_next);
  740.             sort_prev := sort_curr;
  741.             sort_curr := sort_curr^.sort_next;
  742.          end;
  743.       end;
  744.       dispose(sort_curr);
  745.       sort_prev^.sort_next := nil;
  746.    end;
  747.  
  748. (****************************************************************************)
  749. (*                         SORT DIALING DIRECTORY                           *)
  750. (****************************************************************************)
  751.    procedure
  752.       sort_dialing_directory;
  753.    var
  754.       fsize   : integer;
  755.    begin
  756.       mkwin(10,5,71,11,'');
  757.       gotoxy(23,3);
  758.       write('S O R T I N G ');
  759.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  760.       {$I-}
  761.       reset(dialfile);
  762.       {$I+}
  763.       ok := (ioresult = 0);
  764.       if ok then begin
  765.          fsize := filesize(dialfile);
  766.          if fsize > 0 then begin
  767.             load_dial_entries( fsize - 1 );
  768.             sort_dial_entries;
  769.             rewrite_dial_entries;
  770.             close(dialfile);
  771.          end;
  772.       end;
  773.       rmwin;
  774.    end;
  775.  
  776. (****************************************************************************)
  777. (*                             SEND FUNCTION KEY                            *)
  778. (****************************************************************************)
  779.    procedure
  780.       send_func_key( j : integer );
  781.    var
  782.       i             : integer;
  783.       end_of_key  : boolean;
  784.    begin
  785.       i := 0;
  786.       end_of_key := false;
  787.       while ( i < length(func_key[j]) ) and ( not end_of_key ) do begin
  788.          i := i + 1;
  789.          case func_key[j][i] of
  790.             '|' : store_sout_buffer( CR );
  791.             '~' : delay( wait_increment * 3 );
  792.             ';' : end_of_key := true;
  793.          else
  794.             store_sout_buffer( func_key[j][i] );
  795.          end;
  796.       end;
  797.    end;
  798.  
  799. (****************************************************************************)
  800. (*                           MACRO KEY MAINTENANCE                          *)
  801. (****************************************************************************)
  802.    procedure
  803.       display_keys( Fn : integer );
  804.    var
  805.       i    : integer;
  806.    begin
  807.       gotoxy(1,2);
  808.       case Fn of
  809.           1 : writeln(' < Unshifted >');
  810.          11 : writeln(' < Shifted >  ');
  811.          21 : writeln(' < Ctrl >     ');
  812.          31 : writeln(' < Alt >      ');
  813.       else
  814.          ;
  815.       end;
  816.       writeln;
  817.       for i:=1 to 10 do begin
  818.          clreol;
  819.          writeln(i:3,'.  ',func_key[i+Fn-1]);
  820.       end;
  821.    end;
  822.  
  823.    procedure
  824.       page_func_fwd(var Fn : integer);
  825.    begin
  826.       Fn := Fn + 10;
  827.       if Fn > 40 then Fn := Fn - 40;
  828.       display_keys(Fn);
  829.    end;
  830.  
  831.    procedure
  832.       page_func_bak(var Fn : integer);
  833.    begin
  834.       Fn := Fn - 10;
  835.       if Fn < 1 then Fn := Fn + 40;
  836.       display_keys(Fn);
  837.    end;
  838.  
  839.    procedure
  840.       macro_keys;
  841.    var
  842.       i      : integer;
  843.       flg    : boolean;
  844.       Fn     : integer;
  845.    begin
  846.       flg := false;
  847.       mkwin(1,3,80,20,'Function Keys. Use:  | for CR,  ~ for delay,  ; for comment.');
  848.       Fn := 1;
  849.       display_keys(Fn);
  850.       gotoxy(1,16);
  851.       write(' Enter: C=Chg, F=PgFwd, B=PgBak, Q=Quit. ');
  852.       repeat
  853.          gotoxy(42,16);
  854.          clreol;
  855.          repeat until keypressed;
  856.          read(kbd,kbd_char);
  857.          kbd_char := upcase(kbd_char);
  858.          case kbd_char of
  859.             'C' : begin
  860.                      write(' Which One? ');
  861.                      read(i);
  862.                      if ( i > 0 ) and ( i < 11 ) then begin
  863.                         flg := true;
  864.                         gotoxy(7,i+3);
  865.                         input(func_key[i+Fn-1]);
  866.                      end;
  867.                   end;
  868.             'F' : page_func_fwd(Fn);
  869.             'B' : page_func_bak(Fn);
  870.          else
  871.             ;
  872.          end;
  873.       until kbd_char = 'Q';
  874.       if flg then begin
  875.          assign(textfile,dial_PATH+'TMODEM.KEY');
  876.          rewrite(textfile);
  877.          for i:=1 to 40 do writeln(textfile,func_key[i]);
  878.          close(textfile);
  879.       end;
  880.       rmwin;
  881.    end;
  882.  
  883. (****************************************************************************)
  884. (*                          EXECUTE KEYBOARD COMMAND                        *)
  885. (****************************************************************************)
  886.    procedure
  887.       exec_command;
  888.    var
  889.       hold_mode   : boolean;
  890.    begin
  891.       case ch of
  892.          #46  : toggle_capture_mode;
  893.          #45  : exit_program := true;
  894.          #31  : change_comm_params;
  895.          #81  : receive_file;
  896.          #73  : transmit_file;
  897.          #32  : dial_modem;
  898.          #18  : toggle_duplex;
  899.          #113 : give_help;
  900.          #30  : ascii_transmission;
  901.          #16  : hang_up;
  902.          #38  : dir_list;
  903.          #49  : new_directory_drive;
  904.          #47  : view_file;
  905.          #37  : kill_file;
  906.          #34  : redial_modem;
  907.          #50  : macro_keys;
  908.          #24  : sort_dialing_directory;
  909.          #17  : clrscr;
  910.       else
  911.          if ( ch >= #59 )  and  ( ch <= #68 ) then
  912.             send_func_key( ord(ch) - 58 )
  913.          else
  914.             if ( ch >= #84 )  and  ( ch <= #113 ) then
  915.                send_func_key( ord(ch) - 73 );
  916.       end;
  917.    end;
  918.