home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TMODEM.ZIP / TM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-07-05  |  14.8 KB  |  427 lines
  1. {$C-,V-,K-}
  2. (****************************************************************************)
  3. (*                                                                          *)
  4. (*   Author:   Paul Meiners                                                 *)
  5. (*             P & M  Software Company                                      *)
  6. (*             9350 Country Creek #30                                       *)
  7. (*             Houston, Texas 77036                                         *)
  8. (*                                                                          *)
  9. (*   Phone:    (713) 772-2090                                               *)
  10. (*                                                                          *)
  11. (*   Date:     March 3, 1985                                                *)
  12. (*                                                                          *)
  13. (*   Language: Turbo PASCAL version 3.00B                                   *)
  14. (*                                                                          *)
  15. (*   Remarks:  This program provides basic terminal emulation with capture  *)
  16. (*             to disk and XMODEM file transfer.  Uses interrupt driven     *)
  17. (*             serial I/O with circular queues.  Uses a removable window    *)
  18. (*             system.                                                      *)
  19. (*                                                                          *)
  20. (****************************************************************************)
  21.  
  22. program
  23.    TMODEM17;
  24.  
  25. type
  26.    strtype             = string[255];
  27.  
  28. const
  29.    sin_buf_size        = 5120;
  30.    sout_buf_size       = 512;
  31.    max_xmodem_buffers  = 64;
  32.    max_dial_entries    = 16;
  33.    default_stopbits    : integer = 1;
  34.    default_databits    : integer = 8;
  35.    default_parity      : integer = 0;       { 0=none, 1=even, 2=odd }
  36.    default_baud        : integer = 1200;
  37.    datasegment         : integer = 0;
  38.    wait_increment      : integer = 333;     { 1/3 of a second.         }
  39.    XON                 = 17;                { XON  is a DC1 character. }
  40.    XOFF                = 19;                { XOFF is a DC3 character. }
  41.    SOH                 = ^A;
  42.    CAN                 = ^X;
  43.    NAK                 = ^U;
  44.    ACK                 = ^F;
  45.    EOT                 = ^D;
  46.    CR                  = ^M;
  47.    LF                  = ^J;
  48.    CRLF                = ^M^J;
  49.    ESC                 = #27;
  50.    NUL                 = #00;
  51.    FF                  = #12;
  52.    BS                  = #08;
  53.    dial_pre_str        : strtype = 'ATDT ';
  54.    dial_post_str       : strtype = '|';          { | is replaced by CR }
  55.    modem_init_str      : strtype = 'AT S0=0|';
  56.  
  57. type
  58.    string30            = string[30];
  59.    string128           = string[128];
  60.    paritytype          = (none,even,odd);
  61.    capture_ptr_type    = ^capture_record;
  62.    capture_record      = record
  63.                             capture_store_ptr  : integer;
  64.                             capture_buffer     : array[1..1024] of char;
  65.                             capture_next       : capture_ptr_type;
  66.                          end;
  67.    xmodem_buf          = array[1..128] of char;
  68.    registerset         = record
  69.                             AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags : integer;
  70.                          end;
  71.    dialrec             = record
  72.                             bbs_name            : string30;
  73.                             bbs_number          : string30;
  74.                             bbs_baud            : integer;
  75.                             bbs_parity          : integer;
  76.                             bbs_databits        : integer;
  77.                             bbs_stopbits        : integer;
  78.                          end;
  79.    dialarray           = record
  80.                             no_of_dial_entries  : integer;
  81.                             dir_entries         :
  82.                                 array[1..max_dial_entries] of dialrec;
  83.                          end;
  84.    sort_ptr_type       = ^dialsort;
  85.    dialsort            = record
  86.                             sort_rec            : dialrec;
  87.                             sort_next           : sort_ptr_type;
  88.                          end;
  89. var
  90.    rand                : real;
  91.    sin_buffer          : array[1..sin_buf_size] of byte;
  92.    sin_store_ptr       : integer;
  93.    sin_read_ptr        : integer;
  94.    sout_buffer         : array[1..sout_buf_size] of byte;
  95.    sout_store_ptr      : integer;
  96.    sout_read_ptr       : integer;
  97.    sout_int_off        : boolean;
  98.    turn_IRQ_on         : byte;
  99.    turn_IRQ_off        : byte;
  100.    IRQ_vector_ofs      : integer;
  101.    IRQ_vector_seg      : integer;
  102.    hold_vector_ofs     : integer;
  103.    hold_vector_seg     : integer;
  104.    base_com_addr       : integer absolute $0000:$0400;
  105.    int_enable_reg      : integer;
  106.    int_ident_reg       : integer;
  107.    int_ident           : byte;
  108.    modem_control_reg   : integer;
  109.    line_status_reg     : integer;
  110.    line_status         : byte;
  111.    sync_time           : integer;
  112.    xmodem_table        : array[1..max_xmodem_buffers] of xmodem_buf;
  113.    xmodem_buf_cnt      : integer;
  114.    xmodem_ptr          : integer;
  115.    xmodem_rd           : integer;
  116.    continue_transfer   : boolean;
  117.    capture_flag        : boolean;
  118.    capture_warning     : boolean;
  119.    capture_first       : capture_ptr_type;
  120.    capture_curr        : capture_ptr_type;
  121.    sort_curr           : sort_ptr_type;
  122.    sort_first          : sort_ptr_type;
  123.    sort_prev           : sort_ptr_type;
  124.    exit_program        : boolean;
  125.    func_key            : array[1..40] of string128;
  126.    keyfile             : text;
  127.    block_count         : integer;
  128.    error_count         : integer;
  129.    filename            : strtype;
  130.    recv_file           : file;
  131.    xmit_file           : file;
  132.    textfile            : text;
  133.    textimage           : strtype;
  134.    dial_drive          : integer;
  135.    dial_PATH           : strtype;
  136.    dialfile            : file of dialarray;
  137.    dial_dir            : dialarray;
  138.    dialarray_number    : integer;
  139.    dial_str            : strtype;
  140.    baud                : integer;
  141.    stopbits            : integer;
  142.    databits            : integer;
  143.    par                 : integer;
  144.    kbd_char            : char;
  145.    a_key               : string[2];
  146.    regs                : registerset;
  147.    half_duplex         : boolean;
  148.    ascii_mode          : boolean;
  149.    escape_mode         : boolean;
  150.    escape_number       : byte;
  151.    escape_register     : array[1..50] of byte;
  152.    escape_str          : strtype;
  153.    ok                  : boolean;
  154.    parity_ch           : string[10];
  155.    baud_ch             : string[10];
  156.    stop_ch             : string[10];
  157.    data_ch             : string[10];
  158.    FGcolor             : integer;
  159.    BGcolor             : integer;
  160.  
  161. {$I BASIC.INC}
  162. {$I RWINDOW.INC}
  163. (****************************************************************************)
  164. (*                          COMMAND DISTRIBUTOR                             *)
  165. (****************************************************************************)
  166.    procedure
  167.       exec_command(ch : char); FORWARD;
  168.  
  169. (****************************************************************************)
  170. (*                              WAIT FOR A KEY                              *)
  171. (****************************************************************************)
  172.    procedure
  173.       wait_for_key;
  174.    begin
  175.       write(' Press ANY key to continue...');
  176.       repeat
  177.          repeat
  178.             a_key := inkey;
  179.          until a_key <> '';
  180.          if length(a_key) = 2 then begin
  181.             exec_command(a_key[2]);
  182.             a_key := '';
  183.          end;
  184.       until length(a_key) = 1;
  185.    end;
  186.  
  187. {$I DIRECT.INC}
  188. {$I TMODEM.IN1}
  189. {$I TMODEM.IN2}
  190. (****************************************************************************)
  191. (*                            KEYBOARD HANDLER                              *)
  192. (****************************************************************************)
  193.    procedure
  194.       keyboard;
  195.    begin
  196.       if length(a_key) = 1 then begin
  197.          if half_duplex then scrwrite(a_key[1]);
  198.          store_sout_buffer(a_key[1]);
  199.       end
  200.       else
  201.          exec_command(a_key[2]);
  202.    end;
  203.  
  204. (****************************************************************************)
  205. (*                           TERMINAL PROCESSOR                             *)
  206. (****************************************************************************)
  207.    procedure
  208.       terminal_processor;
  209.    begin
  210.       if sin_store_ptr <> sin_read_ptr then begin
  211.             kbd_char := read_sin_buffer;
  212.             scrwrite(kbd_char);
  213.       end;
  214.       a_key := inkey;
  215.       if a_key <> '' then keyboard;
  216.    end;
  217.  
  218. (****************************************************************************)
  219. (*                       INITIALIZE FUNCTION KEYS                           *)
  220. (****************************************************************************)
  221.    procedure
  222.       initialize_function_keys;
  223.    var
  224.       i   : integer;
  225.    begin
  226.       for i:=1 to 40 do func_key[i]:='';
  227.       assign(keyfile,'TMODEM.KEY');
  228.       {$I-}
  229.       reset(keyfile);
  230.       {$I+}
  231.       ok:=(ioresult = 0);
  232.       if not ok then begin
  233.          rewrite(keyfile);
  234.          for i:=1 to 40 do
  235.             writeln(keyfile,func_key[i]);
  236.       end
  237.       else begin
  238.          i :=0;
  239.          while ( not eof(keyfile) ) and ( i < 40 ) do begin
  240.             i := i + 1;
  241.             readln(keyfile,func_key[i]);
  242.          end;
  243.       end;
  244.       close(keyfile);
  245.    end;
  246.  
  247. (****************************************************************************)
  248. (*                             READ CONFIG FILE                             *)
  249. (****************************************************************************)
  250.    procedure
  251.       cr_replace(var s : strtype );
  252.    var
  253.       i  : integer;
  254.    begin
  255.       for i:=1 to length( s ) do begin
  256.          if s[i]='|' then s[i]:=CR;
  257.       end;
  258.    end;
  259.  
  260.    procedure
  261.       read_config_file;
  262.    var
  263.       teststr  : string[2];
  264.       dataval  : integer;
  265.    begin
  266.       assign(textfile,'TMODEM.CNF');
  267.       {$I-}
  268.       reset(textfile);
  269.       {$I+}
  270.       ok:=(ioresult = 0);
  271.       if not ok then begin
  272.          rewrite(textfile);
  273.          writeln(textfile,'ST=',default_stopbits);
  274.          writeln(textfile,'DA=',default_databits);
  275.          writeln(textfile,'PA=',default_parity);
  276.          writeln(textfile,'BA=',default_baud);
  277.          writeln(textfile,'WA=',wait_increment);
  278.          writeln(textfile,'PR=',dial_pre_str);
  279.          writeln(textfile,'PO=',dial_post_str);
  280.          writeln(textfile,'MI=',modem_init_str);
  281.       end
  282.       else begin
  283.          while not eof(textfile) do begin
  284.             readln(textfile,textimage);
  285.             teststr := copy(textimage+'  ',1,2);
  286.             upstring(teststr);
  287.             dataval := bval(copy(textimage+'          ',4,9));
  288.             if teststr = 'ST' then
  289.                default_stopbits := dataval;
  290.             if teststr = 'DA' then
  291.                default_databits := dataval;
  292.             if teststr = 'PA' then
  293.                default_parity := dataval;
  294.             if teststr = 'BA' then
  295.                default_baud := dataval;
  296.             if teststr = 'WA' then
  297.                wait_increment := dataval;
  298.             if teststr = 'PR' then begin
  299.                delete(textimage,1,3);
  300.                dial_pre_str := textimage;
  301.             end;
  302.             if teststr = 'MI' then begin
  303.                delete(textimage,1,3);
  304.                modem_init_str := textimage;
  305.             end;
  306.             if teststr = 'PO' then begin
  307.                delete(textimage,1,3);
  308.                dial_post_str := textimage;
  309.             end;
  310.          end;
  311.       end;
  312.       close(textfile);
  313.       cr_replace( dial_post_str );
  314.       cr_replace( modem_init_str );
  315.    end;
  316.  
  317. (****************************************************************************)
  318. (*                           MAIN  LINE  CODE                               *)
  319. (****************************************************************************)
  320. begin
  321.    randomize;
  322.    FGcolor := white;
  323.    BGcolor := black;
  324.    textcolor( FGcolor );
  325.    textbackground( BGcolor );
  326.    window(1,1,80,25);
  327.    clrscr;
  328.    initwin;
  329.    capture_flag := false;
  330.    ascii_mode := false;
  331.    escape_mode := false;
  332.  
  333.    if base_com_addr = $3F8 then   { Setup vectors and port addresses. }
  334.       begin
  335.          turn_IRQ_on := $EF;
  336.          turn_IRQ_off := $10;
  337.          IRQ_vector_ofs := $0030;
  338.          IRQ_vector_seg := $0032;
  339.       end
  340.    else
  341.       begin
  342.          turn_IRQ_on := $F7;
  343.          turn_IRQ_off := $08;
  344.          IRQ_vector_ofs := $002C;
  345.          IRQ_vector_seg := $002E;
  346.       end;
  347.  
  348.    sin_store_ptr := 1;
  349.    sin_read_ptr := 1;
  350.    sout_store_ptr := 1;
  351.    sout_read_ptr := 1;
  352.    hold_vector_ofs := memw[$0000:IRQ_vector_ofs];
  353.    hold_vector_seg := memw[$0000:IRQ_vector_seg];
  354.    memw[$0000:IRQ_vector_ofs] := ofs(async_intr_handler);
  355.    memw[$0000:IRQ_vector_seg] := CSeg;
  356.    datasegment := DSeg;
  357.    int_enable_reg := base_com_addr + 1;
  358.    int_ident_reg := base_com_addr + 2;
  359.    modem_control_reg := base_com_addr + 4;
  360.    line_status_reg := base_com_addr + 5;
  361.  
  362.    read_config_file;
  363.  
  364.    baud := default_baud;                     { Inialize the serial port. }
  365.    stopbits := default_stopbits;
  366.    databits := default_databits;
  367.    par := default_parity;
  368.    setserial(baud,stopbits,databits,paritytype(par));
  369.    exit_program := false;
  370.    half_duplex := false;
  371.  
  372.    dial_str := modem_init_str;
  373.    dialer;
  374.    dial_str := '';
  375.    dial_drive := ord(default_drive) - ord('A') + 1;
  376.    getdir(dial_drive,dial_PATH);
  377.    if dial_PATH[length(dial_PATH)] <> '\' then
  378.       dial_PATH := dial_PATH + '\';
  379.    initialize_function_keys;
  380.  
  381.    mkwin(2,2,79,22,'TMODEM, ver 1.7');
  382.    writeln;
  383.    writeln;
  384.    writeln;
  385.    writeln;
  386.    writeln;
  387.    writeln('                          Falcon Software Co.');
  388.    writeln('                          2222 E. Beardsley Rd.');
  389.    writeln('                          Phoenix, Arizona 85027');
  390.    writeln;
  391.    writeln;
  392.    writeln;
  393.    writeln;
  394.    writeln;
  395.    writeln;
  396.    writeln;
  397.    writeln;
  398.    writeln;
  399.    escape_win;
  400.    gotoxy(19,23);
  401.    write('Copyright (c) 1987 by: Falcon Software Co.');
  402.    reset_win;
  403.  
  404.    write('Press a Key ');
  405.    repeat
  406.    until keypressed;
  407.    read(kbd,kbd_char);
  408.    display_prompts;
  409.    sin_store_ptr := sin_read_ptr;
  410.    rmwin;
  411.    repeat
  412.       terminal_processor;
  413.    until exit_program;
  414.  
  415.    port[int_enable_reg] := 0;                  { Turn off modem and reset }
  416.    port[modem_control_reg] := 0;               { vectors.                 }
  417.    port[$21] := port[$21] or turn_IRQ_off;
  418.    memw[$0000:IRQ_vector_ofs] := hold_vector_ofs;
  419.    memw[$0000:IRQ_vector_seg] := hold_vector_seg;
  420.  
  421.    if capture_flag then toggle_capture_mode;
  422.    window(1,1,80,25);
  423.    normvideo;
  424.    gotoxy(1,25);
  425.    clreol;
  426.    write('End of Program.');
  427. end.