home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TM40.ZIP / TM2.INC < prev    next >
Encoding:
Text File  |  1985-07-20  |  29.8 KB  |  940 lines
  1. (****************************************************************************)
  2. (*                       COMMUNICATIONS PROBLEMS !!!                        *)
  3. (****************************************************************************)
  4.    procedure
  5.       ask_operator(var ch : char);
  6.    begin
  7.       mkwin(60,18,80,22,'');
  8.       error_count := 0;
  9.       writeln;
  10.       write(' Continue? y/n ');
  11.       readln(yes_no);
  12.       yes_no := upcase(yes_no[1]);
  13.       if yes_no[1] = 'Y' then
  14.          ch := NAK
  15.       else begin
  16.          ch := CAN;
  17.          continue_transfer := false;
  18.       end;
  19.       rmwin;
  20.    end;
  21.  
  22. (****************************************************************************)
  23. (*                              SEND BLOCK                                  *)
  24. (****************************************************************************)
  25.    procedure
  26.       xmit_data(data_block : strtype);
  27.    var
  28.       i         : integer;
  29.    begin
  30.       i := 0;
  31.       while ( i < length(data_block) ) and continue_transfer do begin
  32.          i := succ( i );
  33.          store_sout_buffer(data_block[i]);
  34.          if keypressed then begin
  35.             read(kbd,kbd_char);
  36.             ask_operator(kbd_char);
  37.          end;
  38.       end;
  39.       flush_sin_buff;
  40.    end;
  41.  
  42. (****************************************************************************)
  43. (*                             RECEIVE BLOCK                                *)
  44. (****************************************************************************)
  45.    procedure
  46.       recv_data(var data_block : strtype; char_cnt, wait_cnt : integer);
  47.    var
  48.       cnt      : integer;
  49.       time     : integer;
  50.       max_loop : integer;
  51.    begin
  52.       data_block := '';
  53.       cnt := 0;
  54.       time := wait_increment;
  55.       max_loop := wait_cnt;
  56.       repeat
  57.          if cnt > 0 then
  58.             delay(time);
  59.          if sin_store_ptr <> sin_read_ptr then begin
  60.             data_block := data_block + read_sin_buffer;
  61.             cnt := 0;
  62.             time := sync_time;
  63.             max_loop := 5;
  64.          end
  65.          else
  66.             cnt := succ(cnt);
  67.          if keypressed then begin
  68.             read(kbd,kbd_char);
  69.             ask_operator(kbd_char);
  70.          end;
  71.       until ( cnt > max_loop )
  72.          or ( char_cnt = length(data_block) )
  73.          or ( not continue_transfer );
  74.    end;
  75.  
  76. (****************************************************************************)
  77. (*                             SYNC WITH REMOTE                             *)
  78. (****************************************************************************)
  79.    procedure
  80.       sync_with_remote;
  81.    begin
  82.       sout_read_ptr := sout_store_ptr;
  83.       delay(sync_time);
  84.       while sin_read_ptr <> sin_store_ptr do begin
  85.          flush_sin_buff;
  86.          delay(sync_time);
  87.          delay(sync_time);
  88.       end;
  89.    end;
  90.  
  91.    procedure
  92.       sync_NAK;
  93.    var
  94.       i   : integer;
  95.    begin
  96.       for i:=1 to 20 do sync_with_remote;
  97.    end;
  98.  
  99. (****************************************************************************)
  100. (*                    CALCULATE:  CHECK DIGIT  OR  CRC                      *)
  101. (****************************************************************************)
  102.    procedure                               (***************************)
  103.       ccitt_crc_calc;                      (*  X^16 + X^12 + X^5 + 1  *)
  104.                                            (***************************)
  105.    begin
  106.        inline( $8B/$1E/crc_register );  {        mov     bx,crc_register  }
  107.        inline( $B9/>$08 );              {        mov     cx,8             }
  108.        inline( $A1/crc_input );         {        mov     ax,crc_input     }
  109.        inline( $D0/$D0 );               {  u1:   rcl     al,1             }
  110.        inline( $D1/$D3 );               {        rcl     bx,1             }
  111.        inline( $73/$04 );               {        jnc     u2               }
  112.        inline( $81/$F3/$1021 );         {        xor     bx,1021h         }
  113.        inline( $E2/$F4 );               {  u2:   loop    u1               }
  114.        inline( $89/$1E/crc_register );  {        mov     crc_register,bx  }
  115.    end;
  116.  
  117.    procedure
  118.       calc_chk;
  119.    begin
  120.       if crc_mode then
  121.          ccitt_crc_calc
  122.       else
  123.          crc_register := lo( crc_register +  crc_input );
  124.    end;
  125.  
  126.    procedure
  127.       finalize_crc_calc( si : strtype );
  128.    begin
  129.       crc_input := 0;
  130.       calc_chk;
  131.       calc_chk;
  132.       crc_input := ord( si[132] );
  133.       if crc_mode then
  134.          crc_input := swap( crc_input ) or ord( si[133] );
  135.    end;
  136.  
  137. (****************************************************************************)
  138. (*                       PROCESS XMODEM INPUT BUFFER                        *)
  139. (****************************************************************************)
  140.    procedure
  141.       block_write_buffer;
  142.    begin
  143.       recv_file_size := int( recv_file_size - 127.9 );
  144.       xmodem_buf_cnt := succ(xmodem_buf_cnt);
  145.       if xmodem_buf_cnt = max_xmodem_buffers then begin
  146.          blockwrite(recv_file,xmodem_table_ptr^,max_xmodem_buffers);
  147.          xmodem_buf_cnt := 0;
  148.       end;
  149.    end;
  150.  
  151.    procedure
  152.       write_final_buffers;
  153.    var
  154.       i       : integer;
  155.       handle  : integer;
  156.       tbuffer : array[1..127] of char;
  157.    begin
  158.       blockwrite(recv_file,xmodem_table_ptr^,xmodem_buf_cnt);
  159.       close( recv_file );
  160.  
  161.       { open file }
  162.       filename[length(filename)+1] := chr( 0 );
  163.       regs.DS := seg( filename );
  164.       regs.DX := ofs( filename ) + 1;
  165.       regs.AX := $3D02;
  166.       msdos( regs );
  167.       handle := regs.AX;
  168.  
  169.       { move pointer to end of file }
  170.       regs.AX := $4202;
  171.       regs.BX := handle;
  172.       regs.CX := 0;
  173.       regs.DX := 1;
  174.       msdos( regs );
  175.  
  176.       xmodem_buf_cnt := succ( xmodem_buf_cnt );
  177.       for i:=1 to trunc( recv_file_size ) do
  178.          tbuffer[i] := xmodem_table_ptr^[xmodem_buf_cnt,i];
  179.  
  180.       { write tail to the file }
  181.       regs.BX := handle;
  182.       regs.CX := trunc( recv_file_size );
  183.       regs.DS := seg( tbuffer );
  184.       regs.DX := ofs( tbuffer );
  185.       regs.AX := $4000;
  186.       msdos( regs );
  187.  
  188.       { change files create time }
  189.       if recv_date_time[1] <> 0 then begin
  190.          regs.AX := $5701;
  191.          regs.BX := handle;
  192.          regs.DX := recv_date_time[2];
  193.          regs.CX := recv_date_time[1];
  194.          msdos( regs );
  195.       end;
  196.  
  197.       { close the file }
  198.       regs.AX := $3E00;
  199.       regs.BX := handle;
  200.       msdos( regs );
  201.  
  202.       xmodem_buf_cnt := 0;
  203.       recv_file_size := 0.0;
  204.    end;
  205.  
  206.    function
  207.       send_nak : char;
  208.    var
  209.       rsp      : char;
  210.    begin
  211.       error_count := succ(error_count);
  212.       if error_count > 30 then
  213.          ask_operator(rsp)
  214.       else
  215.          rsp := NAK;
  216.       send_nak := rsp;
  217.       sync_NAK;
  218.    end;
  219.  
  220.    procedure
  221.       process_xmodem_buffer(var pbuf; var resp : char);
  222.    var
  223.       i         : integer;
  224.       xcnt      : integer;
  225.       xbuf      : strtype       absolute pbuf;
  226.       tbuf      : telink_header absolute pbuf;
  227.       hold_mode : boolean;
  228.    begin
  229.       if (ord(xbuf[2]) <> ( ord(xbuf[3]) xor $FF) ) then begin
  230.          resp:=send_nak;
  231.          exit;
  232.       end;
  233.       case xbuf[1] of
  234.          SOH : begin
  235.                   if lo( block_count ) = ord(xbuf[2]) then begin
  236.                      resp := ACK;
  237.                      exit;
  238.                   end;
  239.                   if   (lo( succ( block_count )) <> ord(xbuf[2]))
  240.                     or ( length( xbuf ) <> xblocksize )
  241.                   then begin
  242.                      resp:=send_nak;
  243.                      exit;
  244.                   end;
  245.                   crc_register := 0;
  246.                   xcnt := succ(xmodem_buf_cnt);
  247.                   for i:=4 to 131 do begin
  248.                      crc_input := ord( xbuf[i] );
  249.                      xmodem_table_ptr^[xcnt,i-3] := chr( crc_input );
  250.                      calc_chk;
  251.                   end;
  252.                   finalize_crc_calc( xbuf );
  253.                   if crc_register <> crc_input then begin
  254.                      resp:=send_nak;
  255.                      exit;
  256.                   end;
  257.                   block_count := succ(block_count);
  258.                   if recv_file_size > 128.0 then
  259.                      block_write_buffer
  260.                   else
  261.                      write_final_buffers;
  262.                   resp := ACK;
  263.                   exit;
  264.                end;
  265.          SYN : begin
  266.                   if ( block_count > 0 ) or ( ord(xbuf[2]) > 0 ) then begin
  267.                      resp:=send_nak;
  268.                      exit;
  269.                   end;
  270.                   hold_mode := crc_mode;
  271.                   if length( xbuf ) = 132 then
  272.                      crc_mode := false;
  273.                   crc_register := 0;
  274.                   for i:=4 to 131 do begin
  275.                      crc_input := ord( xbuf[i] );
  276.                      calc_chk;
  277.                   end;
  278.                   finalize_crc_calc( xbuf );
  279.                   crc_mode := hold_mode;
  280.                   if crc_register <> crc_input then begin
  281.                      resp:=send_nak;
  282.                      exit;
  283.                   end;
  284.                   for i:=1 to 4 do
  285.                      recv_create_time[i] := tbuf.telink_create_time[i];
  286.                   recv_file_size := 0.0;
  287.                   for i:=4 downto 1 do
  288.                      recv_file_size := recv_file_size * 256.0 + tbuf.telink_file_size[i];
  289.                   recv_file_size := int( recv_file_size + 0.1 );
  290.                   resp := ACK;
  291.                   exit;
  292.                end;
  293.       end;
  294.       resp:=send_nak;
  295.    end;
  296.  
  297. (****************************************************************************)
  298. (*                             RECEIVE FILE                                 *)
  299. (****************************************************************************)
  300.    procedure
  301.       display_headings( y : integer );
  302.    begin
  303.       gotoxy(1,y);
  304.       clreol;
  305.       writeln;
  306.       writeln('    Block Count    Error Count     Time');
  307.       writeln('    -----------    -----------   --------');
  308.       gotoxy(1,y+4);
  309.       clreol;
  310.    end;
  311.  
  312.    procedure
  313.       display_counts( y : integer );
  314.    begin
  315.       curr_time := time;
  316.       gotoxy(8,y);
  317.       write(block_count:4);
  318.       gotoxy(24,y);
  319.       write(error_count:2);
  320.       gotoxy(34,y);
  321.       curr_time := time;
  322.       writeln(delta_time(start_time,curr_time));
  323.    end;
  324.  
  325.    procedure
  326.       setup_crc_mode( yln : integer );
  327.    begin
  328.       xblocksize := 133;
  329.       crc_mode := true;
  330.       gotoxy(1,yln);
  331.       write(' CRC Mode.');
  332.    end;
  333.  
  334.    procedure
  335.       xmodem_file_recv;
  336.    var
  337.       buf          : strtype;
  338.       response     : char;
  339.       cnt          : byte;
  340.    begin
  341.       assign(recv_file,filename);
  342.       rewrite(recv_file);
  343.       xmodem_buf_cnt := 0;
  344.       error_count := 0;
  345.       block_count := 0;
  346.       continue_transfer := true;
  347.       display_headings( 2 );
  348.       start_time := time + ' ';
  349.       sync_with_remote;
  350.       cnt := 0;
  351.       buf := ' ';
  352.       repeat
  353.          store_sout_buffer( 'C' );
  354.          recv_data(buf,133,9);
  355.          cnt := succ(cnt);
  356.       until ( buf[1] <> ' ' )
  357.          or ( cnt = 2 );
  358.       recv_file_size := 999999999.0;
  359.       case buf[1] of
  360.          SYN : begin
  361.                   setup_crc_mode( 7 );
  362.                   write('  Telink Mode ->',filename);
  363.                end;
  364.          SOH : begin
  365.                   setup_crc_mode( 7 );
  366.                   if batch_mode then write('  Modem7 Mode ->',filename);
  367.                end;
  368.       else
  369.          xblocksize := 132;
  370.          crc_mode := false;
  371.          store_sout_buffer( NAK );
  372.          recv_data(buf,132,40);
  373.       end;
  374.       while ( buf <> CAN )
  375.         and ( buf <> EOT )
  376.         and ( continue_transfer )
  377.       do begin
  378.          process_xmodem_buffer(buf,response);
  379.          if continue_transfer then begin
  380.             display_counts( 5 );
  381.             sync_with_remote;
  382.             store_sout_buffer( response );
  383.             recv_data(buf,xblocksize,40);
  384.          end;
  385.       end;
  386.       sync_with_remote;
  387.       if not continue_transfer then begin
  388.          store_sout_buffer( CAN );
  389.          buf := CAN;
  390.       end;
  391.       if xmodem_buf_cnt > 0 then
  392.          blockwrite(recv_file,xmodem_table_ptr^,xmodem_buf_cnt);
  393.       if recv_file_size > 128.0 then
  394.          close(recv_file);
  395.       if buf = CAN then
  396.          writeln(' File transfer canceled!')
  397.       else begin
  398.          store_sout_buffer( ACK );
  399.          writeln(' File transfer complete.');
  400.       end;
  401.       gotoxy(1,7);
  402.       clreol;
  403.    end;
  404.  
  405. (****************************************************************************)
  406. (*                      GET MODEM7 STYLE FILENAMES                          *)
  407. (****************************************************************************)
  408.    procedure
  409.       get_fname( var fbuf : string20; var st : char );
  410.    var
  411.       cnt       : integer;
  412.       chk       : integer;
  413.       c         : char;
  414.       outerloop : integer;
  415.       m7d       : integer;
  416.    begin
  417.       outerloop := 0;
  418.       fbuf := '';
  419.       cnt := 0;
  420.       chk := ord( SUB );
  421.       m7d := sync_time div 4;
  422.       if m7d < 4 then m7d:=4;
  423.       sync_with_remote;
  424.       store_sout_buffer( NAK );
  425.       repeat
  426.          repeat
  427.             cnt:=succ(cnt);
  428.             if sin_store_ptr <> sin_read_ptr then begin
  429.                c := read_sin_buffer;
  430.                cnt := maxint;
  431.             end
  432.             else
  433.                delay( m7d );
  434.          until (cnt > 500);
  435.          if cnt < maxint then begin
  436.             st := CAN;
  437.             exit;
  438.          end;
  439.          case c of
  440.             ACK  : begin
  441.                       if outerloop > 0 then begin
  442.                          st:=ACK;
  443.                          exit;
  444.                       end;
  445.                    end;
  446.             EOT  : begin
  447.                       st:=CAN;
  448.                       exit;
  449.                    end;
  450.             CAN  : begin
  451.                       st:=CAN;
  452.                       exit;
  453.                    end;
  454.             BADNAME
  455.                  : begin
  456.                       st:=NAK;
  457.                       exit;
  458.                    end;
  459.             SUB  : store_sout_buffer( chr( lo( chk ) ) );
  460.          else
  461.             store_sout_buffer( ACK );
  462.             fbuf := fbuf + c;
  463.             chk :=  chk + ord( c );
  464.          end;
  465.          outerloop := succ(outerloop);
  466.       until outerloop > 20;
  467.       st:=CAN;
  468.    end;
  469.  
  470.    procedure
  471.       parse( s,l : integer; var f,t : strtype );
  472.    var
  473.       cnt    : integer;
  474.       lim    : integer;
  475.    begin
  476.       cnt := s;
  477.       lim := s+l;
  478.       while ( cnt < lim ) and ( f[cnt] <> ' ' ) do begin
  479.          t := t + f[cnt];
  480.          cnt := succ(cnt);
  481.       end;
  482.    end;
  483.  
  484.    procedure
  485.       recv_filename( var fn : strtype );
  486.    var
  487.       fbuf   : string20;
  488.       stat   : char;
  489.       cnt    : byte;
  490.    begin
  491.       if length(fn) > 1 then
  492.          fn := fn[1] + ':'
  493.       else
  494.          fn := '';
  495.       cnt := 0;
  496.       repeat
  497.          cnt := succ(cnt);
  498.          if cnt > 5 then
  499.             stat := CAN
  500.          else
  501.             get_fname( fbuf, stat );
  502.       until (stat = ACK) or (stat = CAN);
  503.       if stat=CAN then
  504.          fn := ''
  505.       else begin
  506.          parse(1,8,fbuf,fn);
  507.          fn:=fn+'.';
  508.          parse(9,3,fbuf,fn);
  509.          if fn[length(fn)]='.' then fn[0]:= chr( ord(fn[0]) - 1 );
  510.       end;
  511.    end;
  512.  
  513. (****************************************************************************)
  514. (*                         RECEIVE FILE EXECUTIVE                           *)
  515. (****************************************************************************)
  516.    procedure
  517.       receive_file;
  518.    var
  519.       hld_name    : string40;
  520.    begin
  521.       mkwin(15,4,62,12,'Receive Xmodem');
  522.       write(' Enter Filename to Receive: ');
  523.       readln(filename);
  524.       hld_name := filename;
  525.       setserial(baud,stopbits,8,0);
  526.       if filename[length(filename)] = '*' then begin
  527.          batch_mode := true;
  528.          recv_filename( filename );
  529.          while length( filename ) > 0 do begin
  530.             xmodem_file_recv;
  531.             filename := hld_name;
  532.             recv_filename( filename );
  533.          end;
  534.       end
  535.       else begin
  536.          if length( filename ) = 0 then begin
  537.             rmwin;
  538.             exit;
  539.          end;
  540.          batch_mode := false;
  541.          xmodem_file_recv;
  542.       end;
  543.       setserial(baud,stopbits,databits,par);
  544.       wait_for_key;
  545.       rmwin;
  546.    end;
  547.  
  548. (****************************************************************************)
  549. (*                            ALLOCATE BUFFERS                              *)
  550. (****************************************************************************)
  551.    procedure
  552.       get_buffer;
  553.    begin
  554.       if xmodem_buf_cnt = 0 then begin
  555.          xmodem_rd := 1;
  556.          while ( xmodem_buf_cnt < max_xmodem_buffers ) and ( xmodem_rd <> 0 )
  557.            do begin
  558.               xmodem_buf_cnt := succ(xmodem_buf_cnt);
  559.               blockread(xmit_file,xmodem_table_ptr^[xmodem_buf_cnt],1,xmodem_rd);
  560.            end;
  561.          xmodem_ptr := 0;
  562.       end;
  563.       xmodem_ptr := succ(xmodem_ptr);
  564.       xmodem_buf_cnt := pred(xmodem_buf_cnt);
  565.    end;
  566.  
  567. (****************************************************************************)
  568. (*                    FORMAT XMODEM OUTPUT BUFFER                           *)
  569. (****************************************************************************)
  570.    procedure
  571.       build_xmodem_buffer(var xbuf : strtype );
  572.    var
  573.       i       : integer;
  574.    begin
  575.       get_buffer;
  576.       xbuf := SOH + chr(lo(block_count)) + chr(lo(block_count) xor $FF);
  577.       crc_register := 0;
  578.       for i:=1 to 128 do begin
  579.          crc_input := ord( xmodem_table_ptr^[xmodem_ptr,i] );
  580.          xbuf := xbuf + chr( crc_input );
  581.          calc_chk;
  582.       end;
  583.       crc_input := 0;
  584.       calc_chk;
  585.       calc_chk;
  586.       if crc_mode then
  587.          xbuf := xbuf + chr( hi( crc_register ) );
  588.       xbuf := xbuf + chr( lo( crc_register ) );
  589.    end;
  590.  
  591. (****************************************************************************)
  592. (*                        GET REMOTE RESPONSE                               *)
  593. (****************************************************************************)
  594.    procedure
  595.       get_response(var resp : char);
  596.    var
  597.       cnt          : integer;
  598.       answer_back  : string10;
  599.    begin
  600.       cnt := 0;
  601.       repeat
  602.          recv_data(answer_back,1,40);
  603.          cnt := succ(cnt);
  604.       until ( cnt = 3 ) or ( answer_back <> '' );
  605.       if ( answer_back[1] = CAN ) or ( answer_back = '' ) then begin
  606.          continue_transfer := false;
  607.          resp := CAN;
  608.       end
  609.       else
  610.          resp := answer_back[1];
  611.    end;
  612.  
  613. (****************************************************************************)
  614. (*                            TRANSMIT FILE                                 *)
  615. (****************************************************************************)
  616.    procedure
  617.       xmodem_file_xmit;
  618.    var
  619.       buf          : strtype;
  620.       response     : char;
  621.       cnt          : integer;
  622.       file_chars   : real;
  623.       file_blks    : real;
  624.    begin
  625.       error_count := 0;
  626.       setserial(baud,stopbits,8,0);
  627.       file_chars := longfilesize( size_file );
  628.       file_blks := file_chars / 128.0;
  629.       xfilesize := trunc( file_blks + 0.001 );
  630.       if frac( file_blks ) > 0.005 then
  631.          xfilesize := succ( xfilesize );
  632.       writeln(' File Size is ',xfilesize,' Blocks.');
  633.       close( size_file );
  634.       assign( xmit_file, filename );
  635.       reset( xmit_file );
  636.       xmodem_buf_cnt := 0;
  637.       block_count := 1;
  638.       continue_transfer := true;
  639.       start_time := time;
  640.       xmit_data('Holding for start of transfer...'+CRLF);
  641.       writeln(' Waiting for start... ');
  642.       writeln;
  643.       cnt := 0;
  644.       repeat
  645.          get_response( response );
  646.          cnt := succ( cnt );
  647.       until ( response = NAK )
  648.          or ( response = 'C' )
  649.          or ( cnt = 3 );
  650.       if response = 'C' then
  651.          setup_crc_mode( 8 )
  652.       else
  653.          crc_mode := false;
  654.       build_xmodem_buffer( buf );
  655.       if response <> CAN then begin
  656.          sync_with_remote;
  657.          xmit_data( buf );
  658.          get_response( response );
  659.          gotoxy(1,3);
  660.          display_headings( 3 );
  661.          display_counts( 6 );
  662.       end;
  663.       while ( response <> EOT )
  664.         and ( response <> CAN )
  665.         and ( continue_transfer )
  666.       do begin
  667.          sync_with_remote;
  668.          case response of
  669.             NAK : begin
  670.                      error_count := succ(error_count);
  671.                      if error_count > 30 then
  672.                         ask_operator(response);
  673.                      sync_NAK;
  674.                      if continue_transfer then begin
  675.                         xmit_data( buf );
  676.                         get_response( response );
  677.                      end;
  678.                   end;
  679.             ACK : begin
  680.                      if block_count = xfilesize then
  681.                         response := EOT
  682.                      else begin
  683.                         block_count := succ(block_count);
  684.                         build_xmodem_buffer( buf );
  685.                         xmit_data(buf);
  686.                         get_response( response );
  687.                      end;
  688.                   end;
  689.          else
  690.             response := NAK;
  691.             error_count := succ(error_count);
  692.          end;
  693.          display_counts( 6 );
  694.       end;
  695.       sync_with_remote;
  696.       if not continue_transfer then begin
  697.          store_sout_buffer( CAN );
  698.          response := CAN;
  699.       end
  700.       else begin
  701.          cnt := 0;
  702.          repeat
  703.             store_sout_buffer( EOT );
  704.             get_response( response );
  705.             cnt := succ(cnt);
  706.          until ( response = ACK ) or ( response = CAN ) or ( cnt = 5 );
  707.       end;
  708.       close(xmit_file);
  709.       setserial(baud,stopbits,databits,par);
  710.       if response = CAN then
  711.          writeln(' File transfer canceled!')
  712.       else
  713.          writeln(' File transmission complete.');
  714.    end;
  715.  
  716.    procedure
  717.       transmit_file;
  718.    begin
  719.       mkwin(15,4,62,13,'Transmit Xmodem');
  720.       repeat
  721.          write(' Enter Filename to Transmit: ');
  722.          readln(filename);
  723.          if length(filename)=0 then begin
  724.             rmwin;
  725.             exit;
  726.          end;
  727.          assign(size_file,filename);
  728.          {$I-}
  729.          reset(size_file);
  730.          {$I+}
  731.          ok := (ioresult = 0);
  732.          if not ok then
  733.             writeln(' Cannot find file: ',filename);
  734.       until ok;
  735.       xmodem_file_xmit;
  736.       wait_for_key;
  737.       rmwin;
  738.    end;
  739.  
  740. (****************************************************************************)
  741. (*                                H E L P                                   *)
  742. (****************************************************************************)
  743.    procedure
  744.       give_help;
  745.    begin
  746.       mkwin(31,1,75,24,'Commands List');
  747.       writeln(' With Alt:');
  748.       writeln('   T = Terminate and return to DOS.');
  749.       writeln('   R = Receive using XMODEM protocol.');
  750.       writeln('   X = Transmit using XMODEM protocol.');
  751.       writeln('   A = Transmit using ASCII XON/XOFF.');
  752.       writeln('   C = Toggle capture mode ON/OFF.');
  753.       writeln('   L = Display the disk directory.');
  754.       writeln('   N = New directory and/or drive.');
  755.       writeln('   V = View file.   K = Kill file.');
  756.       writeln('   Y = Copy file.   M = Macro key defs.');
  757.       writeln('   P = Print file.  I = Change config.');
  758.       writeln('   U = Used time.   F = Fix time.');
  759.       writeln('   D = Dialing.     O = Sort phone #s.');
  760.       writeln('   G = Redial the previous number.');
  761.       writeln('   S = Switch communication parameters.');
  762.       writeln('   E = Toggle between FULL/HALF duplex.');
  763.       writeln('   Q = Hang up.     B = Set line BREAK.');
  764.       writeln('   H = Help menu.   W = Wipe the screen.');
  765.       writeln(' With Ctrl:');
  766.       writeln('   PrtSc = Toggle the printer.');
  767.       writeln;
  768.       wait_for_key;
  769.       rmwin;
  770.    end;
  771.  
  772. (****************************************************************************)
  773. (*                       RECONFIGURE SYSTEM DEFAULTS                        *)
  774. (****************************************************************************)
  775.    procedure
  776.       change_defaults;
  777.    begin
  778.       default_chg := false;
  779.       a_second := round( 3.003004 * wait_increment );
  780.       if emulation_mode[1]<>'F' then silent_mode:=true;
  781.       FG := FGcolor;
  782.       BG := BGcolor;
  783.       textcolor( FG );
  784.       textbackground( BG );
  785.       initwin;
  786.       if split_screen <> old_screen then begin
  787.          if split_screen[1]='T' then
  788.             setup_split
  789.          else
  790.             clrscr;
  791.       end;
  792.       port[int_enable_reg] := 0;              { Turn off modem and reset }
  793.       port[modem_control_reg] := 0;           { vectors.                 }
  794.       port[$21] := port[$21] or turn_IRQ_off;
  795.       memw[$0000:IRQ_vector_ofs] := hold_vector_ofs;
  796.       memw[$0000:IRQ_vector_seg] := hold_vector_seg;
  797.       init_com_port;
  798.       if max_xmodem_buffers <> old_max then begin
  799.          freemem( xmodem_table_ptr, old_max * 128 );
  800.          getmem( xmodem_table_ptr, max_xmodem_buffers * 128 );
  801.       end;
  802.    end;
  803.  
  804.    procedure
  805.       change_default( k : integer );
  806.    var
  807.       i,j    : byte;
  808.       ss     : string10;
  809.    begin
  810.       i := 30;
  811.       j := k+1;
  812.       if k>19 then begin
  813.          i := i + 39;
  814.          j := j - 19;
  815.       end;
  816.       gotoxy(i,j);
  817.       case k of
  818.          1 : num_input(com_port);
  819.          2 : num_input(default_stopbits);
  820.          3 : num_input(default_databits);
  821.          4 : begin
  822.                 str_input(parity_ch);
  823.                 parity_ch := upcase( parity_ch[1] );
  824.                 case parity_ch of
  825.                    'N' : default_parity := 0;
  826.                    'E' : default_parity := 1;
  827.                    'O' : default_parity := 2;
  828.                 end;
  829.              end;
  830.          5 : num_input(default_baud);
  831.          6 : num_input(wait_increment);
  832.          7 : str_input(dial_pre_str);
  833.          8 : str_input(dial_post_str);
  834.          9 : str_input(modem_init_str);
  835.         10 : str_input(speaker_on);
  836.         11 : str_input(speaker_off);
  837.         12 : num_input(redial_time);
  838.         13 : str_input(forced_carrier);
  839.         14 : num_input(carrier_timeout);
  840.         15 : begin
  841.                 str_input(dial_PATH);
  842.                 if dial_PATH[length(dial_PATH)] <> '\' then
  843.                    dial_PATH := dial_PATH + '\';
  844.              end;
  845.         16 : num_input(XON);
  846.         17 : num_input(XOFF);
  847.         18 : str_input(emulation_mode);
  848.         19 : str_input(auto_LF);
  849.         20 : num_input(FGcolor);
  850.         21 : num_input(BGcolor);
  851.         22 : begin
  852.                 ss := comment_ch;
  853.                 str_input(ss);
  854.                 comment_ch := ss[1];
  855.              end;
  856.         23 : str_input(split_screen);
  857.         24 : num_input(max_xmodem_buffers);
  858.       end;
  859.    end;
  860.  
  861.    procedure
  862.       reconfigure_defaults;
  863.    var
  864.       i   : integer;
  865.       ds  : string10;
  866.    begin
  867.       old_max := max_xmodem_buffers;
  868.       old_screen := split_screen;
  869.       default_chg := false;
  870.       mkwin(1,1,80,24,'Reconfigure.  Use: | for CR, ~ for delay.');
  871.       writeln;
  872.       writeln('   1. COM Port Number ...... ',com_port);
  873.       writeln('   2. Number of Stopbits ... ',default_stopbits);
  874.       writeln('   3. Number of Databits ... ',default_databits);
  875.       write  ('   4. Parity Type .......... ');
  876.       case default_parity of
  877.          0 : parity_ch := 'N';
  878.          1 : parity_ch := 'E';
  879.          2 : parity_ch := 'O';
  880.       end;
  881.       writeln(parity_ch);
  882.       writeln('   5. Baud Rate ............ ',default_baud);
  883.       writeln('   6. Time Base ............ ',wait_increment);
  884.       writeln('   7. Dial Pre-String ...... ',dial_pre_str);
  885.       writeln('   8. Dial Post-String ..... ',dial_post_str);
  886.       writeln('   9. Modem Init String .... ',modem_init_str);
  887.       writeln('  10. Speaker-On String .... ',speaker_on);
  888.       writeln('  11. Speaker-Off String ... ',speaker_off);
  889.       writeln('  12. Time Until Redial .... ',redial_time);
  890.       writeln('  13. Forced Carrier ....... ',forced_carrier);
  891.       writeln('  14. Carrier Timeout ...... ',carrier_timeout);
  892.       writeln('  15. Directory PATH ....... ',dial_PATH);
  893.       writeln('  16. XON char, decimal .... ',XON);
  894.       writeln('  17. XOFF char, decimal ... ',XOFF);
  895.       writeln('  18. Emulation Mode ....... ',emulation_mode);
  896.       writeln('  19. Auto Linefeed ........ ',auto_LF);
  897.       gotoxy(42,2);
  898.       write  ('20. Foreground Color ..... ',FGcolor);
  899.       gotoxy(42,3);
  900.       write  ('21. Background Color ..... ',BGcolor);
  901.       gotoxy(42,4);
  902.       write  ('22. Comment Character .... ',comment_ch);
  903.       gotoxy(42,5);
  904.       write  ('23. Split Screen Mode .... ',split_screen);
  905.       gotoxy(42,6);
  906.       write  ('24. Xmodem Buffers ....... ',max_xmodem_buffers);
  907.       gotoxy(2,22);
  908.       write  ('Enter the number to change or RETURN to exit: ');
  909.       repeat
  910.          gotoxy(48,22);
  911.          clreol;
  912.          read(ds);
  913.          i:=bval(ds+' ');
  914.          if i in [ 1..24 ] then begin
  915.             default_chg := true;
  916.             change_default(i);
  917.          end
  918.          else
  919.             i:=0;
  920.       until i=0;
  921.       rmwin;
  922.       if default_chg then begin
  923.          upstring(forced_carrier);
  924.          upstring(dial_PATH);
  925.          upstring(speaker_on);
  926.          upstring(speaker_off);
  927.          upstring(dial_pre_str);
  928.          upstring(dial_post_str);
  929.          upstring(modem_init_str);
  930.          upstring(emulation_mode);
  931.          upstring(auto_LF);
  932.          upstring(split_screen);
  933.          if not ( max_xmodem_buffers in [ 4..255 ] ) then
  934.             max_xmodem_buffers := 64;
  935.          assign(textfile,cnf_PATH+'TMODEM.CNF');
  936.          rewrite_config_file;
  937.          close(textfile);
  938.       end;
  939.    end;
  940.