home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TKERMIT.LBR / KINIT.PQS / KINIT.PAS
Pascal/Delphi Source File  |  2000-06-30  |  5KB  |  135 lines
  1.  
  2.   type
  3.      string1 = string[1];
  4.      string3 = string[3];
  5.      string80 = string[80];
  6.      string15 = string[15];
  7.      string100 = string[150];
  8.      state_vars = (send_init, send_file_header, send_file, send_eof,
  9.                    send_break, receive_init, receive_header, receive_file,
  10.                    send_bye, get_file);
  11.      state_type = array[state_vars] of string[30];
  12.      file_param = (ascii, binary);
  13.      file_type = array[file_param] of string[10];
  14.      parity_param = (no_parity, mark_parity, space_parity, even_parity,
  15.                      odd_parity);
  16.      parity_type = array[parity_param] of string[10];
  17.      port_param = (console, comm, uc1);
  18.      port_type = array[port_param] of string[20];
  19.      packet_param = (break_pack, data_pack, error_pack, header_pack,
  20.                        nak_pack, send_pack, reserved_pack, ack_pack,
  21.                        end_pack, unknown);
  22.      f_modes = (read_open, write_open);
  23.      character = char;
  24.  
  25.   const
  26.     version = 1.1; (* current version number *)
  27.     buffersize = 128; (* program is not set up for any other size right now *)
  28.     file_str : file_type = ('ASCII', 'Binary');
  29.     parity_str : parity_type = ('None', 'Mark', 'Space', 'Even', 'Odd');
  30.     port_str : port_type = ('Console', 'Reader/Punch', 'User Console');
  31.     state_str : state_type = ('send init', 'send file header', 'send file',
  32.                               'send eof', 'send break', 'receive init',
  33.                               'receive header', 'receive file', 'send bye',
  34.                               'get file');
  35.     escape_char = $1c;  (* ^\  control-backslash *)
  36.     bell = ^G;
  37.     init_packet_size = 40; (* use a small packet for testing *)
  38.  
  39.   var
  40.  
  41.     option, bs, cr, lf : char;
  42.     count : integer; (* general purpose count variable *)
  43.     line_command, arg1, arg2, arg3 : string[25]; (* more space for filename *)
  44.     line_buffer : string[80];
  45.     port : integer; (* port value to and/or with iobyte for port setting *)
  46.     done : boolean; (* dummy variable for main proc loop *)
  47.     file_type_var : file_param;
  48.     parity_type_var : parity_param;
  49.     port_type_var : port_param;
  50.     packet_type : packet_param;
  51.     state : state_vars; (* state variable for state switchers *)
  52.     packet_size, timeout, npad, end_of_line : integer;
  53.     pad, quote_char, quote_8, chk_type, repeat_char : char;
  54.     packet_buffer, packet_buffer_data, rec_packet : string[150];
  55.     packet_ok, ack_ok, open_ok, file_done, abort : boolean;
  56.     packet_num, rec_packet_num, packets_sent, packets_bad : integer;
  57.     outfile : file; (* untyped file for read or write *)
  58.     file_open : boolean;
  59.     file_mode : f_modes;
  60.     received_data : string[100];
  61.     quoting : boolean;
  62.     repeating : boolean;
  63.     printing : boolean;
  64.     print_mode : string[3];
  65.     my_pad_char, his_ctl_quote, his_quote_char : char;
  66.     my_pad_num, send_eol : integer;
  67.     debug : boolean;
  68.     debug_mode : string[3];
  69.     iobyte : byte absolute $0003; (* CP/M standard iobyte location *)
  70.     base_iobyte : byte; (* starting iobyte *)
  71.     port_iobyte : byte; (* iobyte for kermit comm port *)
  72.     retry : boolean; (* if you want to force a retry on send or receive packet *)
  73.     maxtry : integer;
  74.     fcb : array[1..36] of byte; (* fcb for dir command *)
  75.     dma : array[1..128] of byte; (* dma buffer for dir command *)
  76.     filebuffer : array[1..buffersize] of char; (* file record read *)
  77.     file_records : integer; (* number of 128 byte records in disk file *)
  78.     filepointer : integer; (* where we are in the record *)
  79.     buffer_num : integer; (* how many 128 byte records have we read or written *)
  80.     receive_done : boolean; (* signals the end of receive command *)
  81.  
  82.   function tab(spaces : integer) : string80;
  83.  
  84.     (* This function generates a string of spaces for formatting printing *)
  85.  
  86.     var count : integer;
  87.         temp : string[80];
  88.  
  89.     begin (* tab *)
  90.       temp := '';
  91.       for count := 1 to spaces do
  92.         temp := temp + ' ';
  93.       tab := temp;
  94.     end; (* tab *)
  95.  
  96.   function ctl(character : char) : char;
  97.  
  98.     (* This function transforms a character to/from a control character *)
  99.  
  100.     begin
  101.       ctl := chr(ord(character) xor $40);
  102.     end;
  103.  
  104.   function char40(number : integer) : char;
  105.     (* add 40 octal to a number for conversion to printable character *)
  106.  
  107.     begin
  108.       char40 := chr(number + 32);
  109.     end;
  110.  
  111.   function unchar(character : char) : integer;
  112.     (* subtract 40 octal from character for conversion back to a number *)
  113.  
  114.     begin
  115.       unchar := ord(character) - 32;
  116.     end;
  117.  
  118.   procedure ltrim(var line : string80);
  119.  
  120.     (* removes leading spaces from a line for parsing the command line *)
  121.  
  122.     begin (* ltrim *)
  123.       while line[1] = ' ' do
  124.         delete(line,1,1);
  125.     end; (* ltrim *)
  126.  
  127.   procedure rtrim(var line: string80);
  128.  
  129.     (* removes trailing spaces from a string to parse the command line *)
  130.  
  131.     begin (* rtrim *)
  132.       while line[length(line)] = ' ' do
  133.         delete(line,length(line),1);
  134.     end; (* rtrim *)
  135.