home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / suncom.zip / SUNCOM.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-24  |  61KB  |  1,613 lines
  1. {$R-,V-,S-}
  2. PROGRAM SUN_Comm;
  3.  
  4. {$M 40000,0,45000}
  5.  
  6. USES
  7.    Crt, Dos, GlobType, PibTimer, PibAsync, Windows,
  8.    Ansidrv, Tpz, MyDos, TpStack, Printer;
  9.  
  10. CONST Max = 150;
  11.       MaxBuffer = 7168;
  12.       MaxBufferLimit = 6656;
  13.       Esc = #27;
  14.       On  = 1;
  15.       Off = 0;
  16.       Pause = 2;
  17.       Send = 1;
  18.       Receive = 0;
  19.       Open_Close : array[0..2] of String[5]
  20.                  = ('Close','Open ','Pause');
  21.       On_Off     : array[0..1] of String[3]
  22.                  = ('OFF ','ON');
  23.       Yes_No     : array[0..2] of String[3]
  24.                  = ('N','Y','Y');
  25.       Ctrl_Keys  : array['A'..'Z'] of Byte
  26.                  = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
  27.                     23,24,25,26);
  28. TYPE
  29.     Str30 = String[30];
  30.     PathType = String[255];
  31.     BytePtr = ^BYTE;
  32.     PtrRec = RECORD
  33.                    Ofs,
  34.                    Seg : WORD;
  35.               END;
  36.     ProtocolRec = record
  37.                        Up,
  38.                        Down : PathType;
  39.                        Name : String[30];
  40.                        Flag : Integer;
  41.                   end;
  42.     ProtoArray = array['A'..'G'] of ProtocolRec;
  43.     FonBookRec = record
  44.                        Name      : Str30;
  45.                        Number    : Str30;
  46.                        BaudRate  : Word;
  47.                        Parity    : Char;
  48.                        DataBits  : Integer;
  49.                        StopBits  : Integer;
  50.                  end;
  51.     FonBookArray = Array[1..Max] of FonBookRec;
  52.     MacrosRec  = record
  53.                    Home_Key,
  54.                    End_Key,
  55.                    Up_Key,
  56.                    Down_Key,
  57.                    Left_Key,
  58.                    Right_Key,
  59.                    PageUp_Key,
  60.                    PageDown_Key,
  61.                    Ins_Key,
  62.                    Del_Key          : String;
  63.                 end;
  64.     ConfigRec = record
  65.                 BaudRate         : Word;             (* Baud rate for connection, e.g., 1200  *)
  66.                 ComPort          : Integer;          (* Which port, e.g., 1 for COM1:         *)
  67.                 Parity           : Char;             (* Parity, e.g., E for even parity       *)
  68.                 DataBits         : Integer;          (* How many bits per Character, e.g., 8  *)
  69.                 StopBits         : Integer;          (* How many stop bits -- nearly always 1 *)
  70.                 InBufSize        : Integer;          (* Size of input buffer                  *)
  71.                 OutBufSize       : Integer;          (* Size of output buffer                 *)
  72.                 Do_XonXoff       : Char;             (* 'Y' to do XON/XOFF flow control       *)
  73.                 Do_HardWired     : Char;             (* 'Y' to do XON/XOFF flow control       *)
  74.                 Do_CTS           : Char;             (* 'Y' to do CTS/RTS flow control        *)
  75.                 Do_DSR           : Char;             (* 'Y' to do DSR/DTR flow control        *)
  76.                 Do_Async_Status  : Byte;             (* Line error reporting off  *)
  77.                 Com_Addr_Str     : String[10];       (* Comm port address in hex string       *)
  78.                 Com_Addr         : Integer;          (* Comm port address                     *)
  79.                 Com_Irq          : Integer;          (* Comm port IRQ address                 *)
  80.                 Com_Int_No       : Integer;          (* Comm port interrupt vector number     *)
  81.                 LocalEcho        : Byte;
  82.                 DirectScreen     : Byte;
  83.                 MuteMode         : Byte;          (* No Sound *)
  84.                 LineFeeds        : Byte;
  85.                 ChatMode         : Byte;
  86.                 Protocols        : ProtoArray;
  87.                 FonBook          : FonBookArray;
  88.                 FilesPath        : String;
  89.                 HideStatusBar    : Byte;
  90.                 ToggleBackSpace  : Byte;
  91.                 Macros           : MacrosRec;
  92.             end;
  93.     BufferType = array[1..MaxBuffer] of Char;
  94.     BufferRec  = Record
  95.                     BufferArray    : BufferType;
  96.                     BufferCounter  : Integer;
  97.                     BufferFileName : String[12];
  98.                     BufferStatus   : Byte;
  99.                  end;
  100. VAR
  101.    CursorCol : Integer;
  102.    CursorRow : Integer;
  103.    WindowPtr : Pointer;
  104.  
  105. (************************************************************************)
  106. {$I suninc.inc}
  107. (************************************************************************)
  108.  
  109. PROCEDURE GetInt(VAR Number  : Integer;
  110.                      Mode    : Byte);
  111. VAR ExitOK  : Boolean;
  112.     Str6    : String[6];
  113.     Num     : LongInt;
  114.     X       : Integer;
  115. begin
  116.      ExitOK := FALSE;
  117.      Str6 := ' ';
  118.      repeat
  119.           case Mode of
  120.                0 : readln(Str6);
  121.                1 : read(Str6);
  122.           end; {Case}
  123.           val(Str6,Num,X);
  124.           if (Num <= 32767) and (Num >= -32767)
  125.              then ExitOK := TRUE;
  126.      until ExitOK = TRUE;
  127.      Number := Num;
  128. end;
  129.  
  130. (************************************************************************)
  131.  
  132. PROCEDURE GetChar(VAR Chars : Char;
  133.                       Mode  : Integer);
  134. begin
  135.      case Mode of
  136.          0 : Chars := Readkey;
  137.          1 : readln(Chars);
  138.          2 : read(Chars);
  139.      end; {case}
  140.      Chars := upcase(Chars);
  141. end;
  142.  
  143. (************************************************************************)
  144.  
  145. PROCEDURE GetStr(VAR TempStr : String;
  146.                      Mode    : Integer);
  147. begin
  148.      case Mode of
  149.          0 : readln(TempStr);
  150.          1 : read(TempStr);
  151.      end; {case}
  152. end;
  153.  
  154. (************************************************************************)
  155.  
  156. PROCEDURE Clear_Config(VAR Config : ConfigRec);
  157. VAR Lcv      : Integer;
  158.     Counter  : Char;
  159. begin
  160.     with Config do
  161.     begin
  162.     for Counter := 'A' to 'G' do
  163.     begin
  164.          Protocols[Counter].Up   := ' ';
  165.          Protocols[Counter].Down := ' ';
  166.          Protocols[Counter].Name := ' ';
  167.          Protocols[Counter].Flag := Off;
  168.     end;
  169.     for Lcv := 1 to Max do
  170.     begin
  171.         with FonBook[Lcv] do
  172.         begin
  173.            Name      := ' ';
  174.            Number    := ' ';
  175.            BaudRate  := 1200;
  176.            Parity    := 'N';
  177.            DataBits  := 8;
  178.            StopBits  := 1;
  179.         end;
  180.     end;
  181.     BaudRate        := 1200;         (* Baud rate for connection, e.g., 1200  *)
  182.     ComPort         := 1;            (* Which port, e.g., 1 for COM1:         *)
  183.     Parity          := 'N';          (* Parity, e.g., E for even parity       *)
  184.     DataBits        := 8;            (* How many bits per Character, e.g., 8  *)
  185.     StopBits        := 1;            (* How many stop bits -- nearly always 1 *)
  186.     InBufSize       := 1024;         (* Size of input buffer                  *)
  187.     OutBufSize      := 1024;         (* Size of output buffer                 *)
  188.     Do_XonXoff      := 'N';          (* 'Y' to do XON/XOFF flow control       *)
  189.     Do_HardWired    := 'N';          (* 'Y' to do XON/XOFF flow control       *)
  190.     Do_CTS          := 'N';          (* 'Y' to do CTS/RTS flow control        *)
  191.     Do_DSR          := 'N';          (* 'Y' to do DSR/DTR flow control        *)
  192.     Do_Async_Status := Off;         (* Line error reporting off              *)
  193.     Com_Addr_Str    := '02e8';       (* Comm port address in hex string       *)
  194.     Com_Addr := Hex_To_Dec( Com_Addr_Str , -1 );
  195.                                      (* Comm port address                     *)
  196.     Com_Irq         :=  4;           (* Comm port IRQ address                 *)
  197.     Com_Int_No      := -1;           (* Comm port interrupt vector number     *)
  198.                                      (* Use -1 if Not Sure                    *)
  199.     LocalEcho       := Off;
  200.     DirectScreen    := On;
  201.     MuteMode        := Off;          (* No Sound *)
  202.     LineFeeds       := Off;
  203.     ChatMode        := Off;
  204.     FilesPath       := 'C:\programs';
  205.     HideStatusBar   := Off;
  206.     ToggleBackSpace := Off;
  207.     with Macros do
  208.     begin
  209.     Home_Key        := ' ';
  210.     End_Key         := ' ';
  211.     Up_Key          := ' ';
  212.     Down_Key        := ' ';
  213.     Left_Key        := ' ';
  214.     Right_Key       := ' ';
  215.     PageUp_Key      := ' ';
  216.     PageDown_Key    := ' ';
  217.     Ins_Key         := ' ';
  218.     Del_Key         := #127
  219.     end; {with2}
  220.     end; {with}
  221.     DirectVideo     := TRUE;
  222. end;
  223.  
  224.  
  225. (************************************************************************)
  226.  
  227. PROCEDURE Install_Protocols(VAR Config : ConfigRec);
  228. VAR Question,
  229.     Counter  : Char;
  230.     OldPath   : String[80];
  231. begin
  232.      window(1,1,80,25);
  233.      WINDOWIN(white,blue,4,15,4,65,18,CursorCol,CursorRow,WindowPtr);
  234.      while (Question <> Esc) do
  235.      begin
  236.      MAKEWINDOW(white,blue,4,0,15,4,65,18);
  237.      textcolor(yellow);
  238.      with Config do
  239.      begin
  240.      writeln('                Install Protocols');
  241.      LINE(196,49,white);
  242.      writeln;
  243.      textcolor(yellow);
  244.      for Counter := 'A' to 'G' do
  245.         begin
  246.              with Protocols[Counter] do
  247.              begin
  248.                 writeln(Counter:15,' - ',Name);
  249.              end; {with}
  250.         end; {for}
  251.      textcolor(lightgray);
  252.      writeln;
  253.      writeln('               Press ESC to Exit');
  254.      OffCursor;
  255.      Question := ReadKey;
  256.      Question := Upcase(Question);
  257.      OnCursor;
  258.      if Question in ['A'..'G'] then
  259.                begin
  260.                     OldPath := Protocols[Question].Name;
  261.                     SETSCREEN(black,white,0,5,20,75,20);
  262.                     write(' Name: ',Protocols[Question].Name);
  263.                     window(12,20,75,20);
  264.                     textcolor(red);
  265.                     readln(Protocols[Question].Name);
  266.                     if length(Protocols[Question].Name) <= 1
  267.                        then Protocols[Question].Name := OldPath;
  268.                     OldPath := Protocols[Question].Up;
  269.                     SETSCREEN(black,white,0,5,20,75,20);
  270.                     write(' Up Path: ',Protocols[Question].Up);
  271.                     window(15,20,75,20);
  272.                     textcolor(red);
  273.                     readln(Protocols[Question].Up);
  274.                     if length(Protocols[Question].Up) <= 1
  275.                        then Protocols[Question].Up := OldPath;
  276.                     OldPath := Protocols[Question].Down;
  277.                     SETSCREEN(black,white,0,5,20,75,20);
  278.                     write(' Down Path: ',Protocols[Question].Down);
  279.                     window(17,20,75,20);
  280.                     textcolor(red);
  281.                     readln(Protocols[Question].Down);
  282.                     if length(Protocols[Question].Down) <= 1
  283.                        then Protocols[Question].Down := OldPath;
  284.                     Protocols[Question].Flag := 1;
  285.                 end;
  286.      end; {while}
  287.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  288.      end; {with}
  289. end;
  290.  
  291. (************************************************************************)
  292.  
  293. PROCEDURE SaveConfig(VAR Config : ConFigRec);
  294. VAR CfgFile    : Text;
  295.     Counter    : Char;
  296.     Lcv        : Integer;
  297. BEGIN
  298.   SETSCREEN(LightCyan+Blink,blue,0,10,21,70,21);
  299.   write('                Saving Config File...');
  300.   {$I-}
  301.   chdir(Config.FilesPath);
  302.   {$I+}
  303.   Assign(CfgFile, 'SunCom.CFG');
  304.   Rewrite(CfgFile);
  305.   with Config do
  306.   begin
  307.   writeln(CfgFile,ComPort);
  308.   writeln(CfgFile,BaudRate);
  309.   writeln(CfgFile,Parity);
  310.   writeln(CfgFile,DataBits);
  311.   writeln(CfgFile,StopBits);
  312.   writeln(CfgFile,LocalEcho);
  313.   writeln(CfgFile,LineFeeds);
  314.   writeln(CfgFile,ChatMode);
  315.   writeln(CfgFile,MuteMode);
  316.   writeln(CfgFile,InBufSize);
  317.   writeln(CfgFile,OutBufSize);
  318.   writeln(CfgFile,Do_XonXoff);
  319.   writeln(CfgFile,Do_HardWired);
  320.   writeln(CfgFile,Do_CTS);
  321.   writeln(CfgFile,Do_DSR);
  322.   writeln(CfgFile,Com_Addr_Str);
  323.   writeln(CfgFile,Com_Addr);
  324.   writeln(CfgFile,Com_IRQ);
  325.   writeln(CfgFile,Com_INT_No);
  326.   writeln(CfgFile,DirectScreen);
  327.   writeln(CfgFile,Do_Async_Status);
  328.   writeln(CfgFile,HideStatusBar);
  329.   for Counter := 'A' to 'G' do
  330.       begin
  331.            writeln(CfgFile,Protocols[Counter].Name);
  332.            writeln(CfgFile,Protocols[Counter].Up);
  333.            writeln(CfgFile,Protocols[Counter].Down);
  334.            writeln(CfgFile,Protocols[Counter].Flag);
  335.       end; {for}
  336.   writeln(CfgFile,FilesPath);
  337.   for Lcv := 1 to Max do
  338.       begin
  339.            writeln(CfgFile,FonBook[Lcv].Name);
  340.            writeln(CfgFile,FonBook[Lcv].Number);
  341.       end;
  342.   end; {with}
  343.   close(CfgFile);
  344.   delay(3000);
  345.   writeln;
  346.   window(3,3,77,21);
  347. END (* SaveConfig *);
  348.  
  349. (****************************************************************************)
  350.  
  351. PROCEDURE Load_Macros(VAR Config : ConfigRec);
  352. VAR CfgFile : Text;
  353. begin
  354.    {$I-}
  355.    chdir(Config.FilesPath);
  356.    assign(CfgFile,'SunCom.Mac');
  357.    reset(CfgFile);
  358.    {$I+}
  359.    if IOresult <> 0
  360.       then begin
  361.                 MAKEWINDOW(white,red,4,0,30,10,50,12);
  362.                 write(' *** IO ERROR ***',^G,^G);
  363.                 delay(10000);
  364.                 exit;
  365.            end;
  366.    with Config.Macros do
  367.    begin
  368.    readln(CfgFile,PageUp_Key);
  369.    readln(CfgFile,PageDown_Key);
  370.    readln(CfgFile,Home_Key);
  371.    readln(CfgFile,End_Key);
  372.    readln(CfgFile,Up_Key);
  373.    readln(CfgFile,Down_Key);
  374.    readln(CfgFile,Left_Key);
  375.    readln(CfgFile,Right_Key);
  376.    readln(CfgFile,Ins_Key);
  377.    readln(CfgFile,Del_Key);
  378.    end; {with}
  379.    close(CfgFile);
  380. end;
  381.  
  382. (****************************************************************************)
  383.  
  384. PROCEDURE Save_Macros(VAR Config : ConfigRec);
  385. VAR CfgFile : Text;
  386. begin
  387.    {$I-}
  388.    chdir(Config.FilesPath);
  389.    {$I+}
  390.    assign(CfgFile,'SunCom.Mac');
  391.    rewrite(CfgFile);
  392.    with Config.Macros do
  393.    begin
  394.    writeln(CfgFile,PageUp_Key);
  395.    writeln(CfgFile,PageDown_Key);
  396.    writeln(CfgFile,Home_Key);
  397.    writeln(CfgFile,End_Key);
  398.    writeln(CfgFile,Up_Key);
  399.    writeln(CfgFile,Down_Key);
  400.    writeln(CfgFile,Left_Key);
  401.    writeln(CfgFile,Right_Key);
  402.    writeln(CfgFile,Ins_Key);
  403.    writeln(CfgFile,Del_Key);
  404.    end; {with}
  405.    close(CfgFile);
  406. end;
  407.  
  408. (************************************************************************)
  409.  
  410. PROCEDURE Define_Macros(VAR Config : ConfigRec);
  411. VAR
  412.    Choice,
  413.    YesNo       : Char;
  414. LABEL Beginning;
  415. BEGIN (* Get_Comm_Params *)
  416.    with Config.Macros do begin
  417.    WINDOWIN(white,blue,4,2,2,78,24,CursorCol,CursorRow,WindowPtr);
  418.    writeln('                        SUN Comm Define Macro Keys');
  419.    LINE(196,75,white);
  420.    Beginning:
  421.    OffCursor;
  422.    window(3,5,77,23);
  423.    textbackground(blue);
  424.    textcolor(yellow);
  425.    clrscr;
  426.    writeln;
  427.    writeln('     A - PgUp ');
  428.    writeln('     B - PgDown ');
  429.    writeln('     C - Home ');
  430.    writeln('     D - End  ');
  431.    writeln('     E - Up   ');
  432.    writeln('     F - Down ');
  433.    writeln('     G - Left ');
  434.    writeln('     H - Right');
  435.    writeln('     I - Ins  ');
  436.    writeln('     J - Del  ');
  437.    window(20,6,77,21);
  438.    textcolor(white);
  439.    writeln(PageUp_Key);
  440.    writeln(PageDown_Key);
  441.    writeln(Home_Key);
  442.    writeln(End_Key);
  443.    writeln(Up_Key);
  444.    writeln(Down_Key);
  445.    writeln(Left_Key);
  446.    writeln(Right_Key);
  447.    writeln(Ins_Key);
  448.    writeln(Del_Key);
  449.    window(3,17,77,22);
  450.    textcolor(lightcyan);
  451.    writeln('         ^n  -  Control Char + Letter     ^M  -  Carriage Return');
  452.    writeln('         ^[  -  ESC                       ~   -  1 sec wait ');
  453.    writeln('      ##000  -  To Send a ASCII/Graphic Char');
  454.    textcolor(lightgray);
  455.    writeln;
  456.    write('                              ESC - To Exit');
  457.    Choice := Readkey;
  458.    Choice := upcase(Choice);
  459.    OnCursor;
  460.    if Choice = ESC
  461.         then begin
  462.                 WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  463.                 Exit;
  464.              end;
  465.    if Not(Choice in ['A'..'J','L','S'])
  466.       then goto beginning;
  467.    if Choice in ['A'..'J']
  468.       then SETSCREEN(black,white,0,20,Ord(Choice)-59,77,Ord(Choice)-59);
  469.    case Choice of
  470.            'A' : GetStr(PageUp_Key,0);
  471.            'B' : GetStr(PageDown_Key,0);
  472.            'C' : GetStr(Home_Key,0);
  473.            'D' : GetStr(End_Key,0);
  474.            'E' : GetStr(Up_Key,0);
  475.            'F' : GetStr(Down_Key,0);
  476.            'G' : GetStr(Left_Key,0);
  477.            'H' : GetStr(Right_Key,0);
  478.            'I' : GetStr(Ins_Key,0);
  479.            'J' : GetStr(Del_Key,0);
  480.            'L' : Load_Macros(Config);
  481.            'S' : Save_Macros(Config);
  482.    end; {case}
  483.    goto Beginning;
  484.    end; {with}
  485. end;   (* Define Macros *)
  486.  
  487. (****************************************************************************)
  488.  
  489. PROCEDURE ShowPortStatus(VAR Config : ConfigRec;
  490.                          VAR Buffer : BufferRec);
  491. VAR
  492.   Lcv,
  493.   X,
  494.   Y,
  495.   Top,
  496.   Bottom    : BYTE;
  497.   DispStr   : STRING;
  498.   WkStr     : STRING[18];
  499. BEGIN
  500.   with Config do begin
  501.   with Buffer do begin
  502.     if (HideStatusBar = On) or (Config.HideStatusBar = 2)
  503.        then begin
  504.                if HideStatusBar = On then SETSCREEN(white,black,0,1,1,80,25);
  505.                HideStatusBar := 2;
  506.                exit;
  507.             end;
  508.     SETSCREEN(black,white,0,1,25,80,25);
  509.     if BufferStatus = Off
  510.        then write(chr(177),' SunCom v1.0   ',chr(177),'  ALT Q = Help  ',chr(177),' ')
  511.        else write(chr(177),' Buffer: ',Open_Close[BufferStatus],' ',chr(177),'  ALT Q = Help  ',chr(177),' ');
  512.     DispStr := '';
  513.     str(BaudRate,WkStr);
  514.     DispStr := DispStr + WkStr + ',' + Parity + ',';
  515.     str(DataBits,WkStr);
  516.     DispStr := DispStr + WkStr + ',';
  517.     Str(StopBits,WkStr);
  518.     DispStr := DispStr + WkStr;
  519.     gotoxy(40,25);
  520.     write(DispStr,' ',chr(177));
  521.     if LocalEcho = On
  522.        then write(' ECHO ',chr(177))
  523.        else write(' OFF  ',chr(177));
  524.     if LineFeeds = On
  525.        then write(' LF  ',chr(177))
  526.        else write(' OFF ',chr(177));
  527.     if ChatMode = On
  528.        then write(' CHAT ',chr(177))
  529.        else write(' OFF  ',chr(177));
  530.     if ToggleBackSpace = On
  531.        then write(' DEL  ',chr(177))
  532.        else write(' BKSP ',chr(177));
  533.     if MuteMode = Off
  534.        then write(' ',chr(14),' ',chr(177))
  535.        else write('   ',chr(177));
  536.     OnCursor;
  537.   end; {with - Buffer};
  538.   end; {with - Config};
  539.   SetScreen(white,black,1,1,1,80,24);
  540. end;
  541.  
  542. (************************************************************************)
  543.  
  544. PROCEDURE Setup(VAR Config : ConfigRec);
  545. VAR
  546.    Choice,
  547.    YesNo       : Char;
  548. LABEL Beginning;
  549. begin (* Setup *)
  550.    with Config do
  551.    begin
  552.    WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  553.    writeln('                        SUN Comm Advanced Setup');
  554.    LINE(196,75,white);
  555.    Beginning:
  556.    OffCursor;
  557.    window(3,5,77,21);
  558.    textbackground(blue);
  559.    textcolor(yellow);
  560.    clrscr;
  561.    writeln;
  562.    writeln('     A - Size in bytes of async receive buffer: ');
  563.    writeln('     B - Size in bytes of async output buffer:  ');
  564.    writeln('     C - Use XON/XOFF flow control (Y/N)?  ');
  565.    writeln('     D - Do CTS/RTS flow control (Y/N)?  ');
  566.    writeln('     E - Do DSR/DTR flow control (Y/N)?  ');
  567.    writeln('     F - Is connection hard-wired (Y/N)?  ');
  568.    writeln('     G - Line Error reporting (Y/N)?  ');
  569.    writeln('     H - Direct Screen Write (Y/N)?  ');
  570.    writeln('     I - Hide Status Bar (Y/N)? ');
  571.    writeln('     J - Use <DEL> instead of ^H for Backspace (Y,N)? ');
  572.    gotoxy(30,15);
  573.    textcolor(lightgray);
  574.    writeln('ESC - To Exit');
  575.    window(60,6,77,21);
  576.    textcolor(white);
  577.    writeln(InBufSize);
  578.    writeln(OutBufSize);
  579.    writeln(Do_XonXoff);
  580.    writeln(Do_CTS);
  581.    writeln(Do_DSR);
  582.    writeln(Do_HardWired);
  583.    writeln(Yes_No[Do_Async_Status]);
  584.    writeln(Yes_No[DirectScreen]);
  585.    writeln(Yes_No[HideStatusBar]);
  586.    writeln(Yes_No[ToggleBackSpace]);
  587.    Choice := Readkey;
  588.    Choice := upcase(Choice);
  589.    OnCursor;
  590.    if Choice = ESC
  591.         then begin
  592.                 Exit;
  593.              end;
  594.    if Not(Choice in ['A'..'J'])
  595.       then goto beginning;
  596.    SETSCREEN(black,white,0,60,Ord(Choice)-59,70,Ord(Choice)-59);
  597.    case Choice of
  598.            'A' : GetInt(InBufSize,0);
  599.            'B' : GetInt(OutBufSize,0);
  600.            'C' : GetChar(Do_XonXoff,0);
  601.            'D' : GetChar(Do_CTS,0);
  602.            'E' : GetChar(Do_DSR,0);
  603.            'F' : GetChar(Do_HardWired,0);
  604.            'G' : begin
  605.                     GetChar(YesNo,0);
  606.                     if YesNo in ['Y','y']
  607.                        then Do_Async_Status := On
  608.                        else Do_Async_Status := Off;
  609.                  end;
  610.            'H' : begin
  611.                     GetChar(YesNo,0);
  612.                     if YesNo in ['Y','y']
  613.                        then begin
  614.                                DirectScreen := On;
  615.                                DirectVideo  := TRUE;
  616.                              end
  617.                        else begin
  618.                                DirectScreen := Off;
  619.                                DirectVideo  := FALSE;
  620.                             end;
  621.                  end;
  622.            'I' : begin
  623.                     GetChar(YesNo,0);
  624.                     if YesNo in ['Y','y']
  625.                        then HideStatusBar := On
  626.                        else HideStatusBar := Off;
  627.                  end;
  628.            'J' : begin
  629.                     GetChar(YesNo,0);
  630.                     if YesNo in ['Y','y']
  631.                        then ToggleBackSpace := On
  632.                        else ToggleBackSpace := Off;
  633.                  end;
  634.    end; {case}
  635.    end; {with - Config}
  636. end;  (* Setup *)
  637.  
  638. (****************************************************************************)
  639.  
  640. PROCEDURE Clear_Buffer(VAR Buffer : BufferRec);
  641. VAR Counter : Integer;
  642. begin
  643.    with Buffer do
  644.    begin
  645.         BufferStatus   := Off;
  646.         BufferFileName := 'SunCom.Buf';
  647.         BufferCounter  := 1;
  648.         for Counter := 1 to MaxBuffer do
  649.             begin
  650.                  BufferArray[Counter] := ' ';
  651.             end;
  652.    end; {with - Buffer}
  653. end;
  654.  
  655. (****************************************************************************)
  656.  
  657. FUNCTION Initialize(VAR Config : ConfigRec;
  658.                     VAR Buffer : BufferRec) : Boolean;
  659. CONST
  660.    Digits : ARRAY[0..15] OF Char = ('0','1','2','3','4','5','6','7','8','9',
  661.                                     'A','B','C','D','E','F');
  662. VAR Flags   : Byte;
  663. BEGIN (* Initialize*)
  664.    with Config do begin
  665.    Async_Do_CTS         := ( UpCase( Do_CTS ) = 'Y' );        (* Set CTS checking *)
  666.    Async_Do_DSR         := ( UpCase( Do_DSR ) = 'Y' );        (* Set DSR checking *)
  667.    Async_Do_XonXoff     := ( UpCase( Do_XonXoff ) = 'Y' );    (* Set XON/XOFF to user request *)
  668.    Async_Hard_Wired_On  := ( UpCase( Do_HardWired ) = 'Y' );  (* Set hard-wired as user requests *)
  669.    Async_Break_Length   := 500;                               (* Set half-second break duration *)
  670.    Async_Init(InBufSize, OutBufSize,0,0,0);               (* Let XON/XOFF break points default. *)
  671.        (* If com port 3 or 4, make sure port address specified in memory. *)
  672.    IF ( ComPort > 2 ) THEN
  673.       Async_Setup_Port( ComPort,Com_Addr, Com_Irq, Com_Int_No );
  674.      (* Try opening the serial port.   *)
  675.    IF ( NOT Async_Open( ComPort, BaudRate, Parity, DataBits, StopBits ) ) THEN
  676.       BEGIN
  677.          WRITELN('Cannot open serial port.');
  678.          Initialize := FALSE;
  679.       END
  680.    ELSE
  681.       BEGIN
  682.          SETSCREEN(white,black,0,1,1,80,24);
  683.          WRITELN('SUN Terminal ready.');
  684.          Initialize := TRUE;
  685.       END;
  686.    IF Do_Async_Status = On THEN
  687.          IF Async_Line_Error(Flags) THEN
  688.             BEGIN
  689.                WRITELN;
  690.                WRITELN( 'Line error = <', Digits[ Flags SHR 4 ],
  691.                                           Digits[ Flags AND $F ], '>' );
  692.             END;
  693.    CLEAR_BUFFER(Buffer);
  694.    end; {with - Config}
  695. END   (* Initialize *);
  696.  
  697. (****************************************************************************)
  698.  
  699. PROCEDURE Set_FilesPath(VAR Config : ConfigRec);
  700. VAR ExitFlag : Boolean;
  701.     OldPath  : String[80];
  702. begin
  703.      WINDOWIN(white,blue,4,5,11,75,13,CursorCol,CursorRow,WindowPtr);
  704.      ONCURSOR;
  705.      ExitFlag := False;
  706.      with Config do
  707.      begin
  708.      while ExitFlag <> True do
  709.      begin
  710.      textcolor(yellow);
  711.      OldPath := FilesPath;
  712.      write('Files Path: ',FilesPath);
  713.      window(18,12,74,12);
  714.      textcolor(lightred);
  715.      readln(FilesPath);
  716.      if length(FilesPath) <= 1
  717.         then FilesPath := OldPath;
  718.      if FilesPath[length(FilesPath)] = '\'
  719.         then delete(FilesPath,Length(FilesPath),1);
  720.      {$I-}
  721.      chdir(FilesPath);
  722.      {$I+}
  723.      if IOResult <> 0
  724.         then begin
  725.                   window(6,12,74,12);
  726.                   textcolor(lightred+blink);
  727.                   writeln;
  728.                   write('INVALID PATH!',^g);
  729.                   delay(3000);
  730.                   window(6,12,74,12);
  731.                   writeln;
  732.                   FilesPath := ' ';
  733.                   ExitFlag := False;
  734.              end
  735.         else ExitFlag := True;
  736.      end; {while}
  737.      end; {with}
  738.      OFFCURSOR;
  739.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  740. end;
  741.  
  742. (****************************************************************************)
  743.  
  744. PROCEDURE Modem_Config_Menu(VAR Config : ConfigRec;
  745.                             VAR Buffer : BufferRec);
  746. VAR
  747.   dbool,
  748.   WinOutFlag : Boolean;
  749.   Ch,
  750.   Choice     : Char;
  751.   HighComm   : Byte;
  752.   ChoiceInt  : Integer;
  753.   TempStr    : String[20];
  754. LABEL Beginning;
  755. BEGIN
  756.      with Config do
  757.      begin
  758.      WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  759.      Beginning:
  760.      clrscr;
  761.      WinOutFlag := False;
  762.      HighComm := Off;
  763.      textcolor(white);
  764.      OffCursor;
  765.      writeln('                            SUN Comm Modem Setup');
  766.      LINE(196,75,white);
  767.      textcolor(yellow);
  768.      writeln('   BAUD RATE      PARITY       DATA BITS              OTHER         ');
  769.      writeln;
  770.      writeln('   A -  1200     K - Even    R - 7 bits       T - Install Protocols ');
  771.      writeln('   B -  2400     L - Space   S - 8 bits       U - Save Configuration');
  772.      writeln('   C -  9600     M - Mark                     V - Advanced Setup    ');
  773.      writeln('   D - 19200     N - None                     W - Set Files Path    ');
  774.      writeln('   E - 38400     O - Odd                      X - Define Macros     ');
  775.      writeln('   F - 57600                                  Y -                   ');
  776.      writeln('                                              Z -                   ');
  777.      writeln('   COM PORT      STOP BITS                                          ');
  778.      writeln('                                                                    ');
  779.      writeln('   G - Com 1     P - 1 bits     ESC - To Exit                       ');
  780.      writeln('   H - Com 2     Q - 2 bits                                         ');
  781.      writeln('   I - Com 3                    Current Config: Com',ComPort,',',BaudRate,',',Parity,',',DataBits,',',StopBits);
  782.      if ComPort < 2
  783.         then writeln('   J - Com 4                                                        ')
  784.         else writeln('   J - Com 4                    Com Addr: ',Com_Addr_Str,'  IRQ #: ',Com_IRQ);
  785.      Choice := Readkey;
  786.      Choice := upcase(Choice);
  787.      OnCursor;
  788.      if Choice = ESC
  789.         then begin
  790.                 OnCursor;
  791.                 if Initialize(Config,Buffer) = False then
  792.                    begin
  793.                         writeln(^G,'ComPort NOT Opened!',^G);
  794.                         delay(3000);
  795.                    end;
  796.                 ShowPortStatus(Config,Buffer);
  797.                 if WinOutFlag = False then WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  798.                 OnCursor;
  799.                 Exit;
  800.              end;
  801.      CASE Choice OF
  802.            'A' : BaudRate := 1200;
  803.            'B' : BaudRate := 2400;
  804.            'C' : BaudRate := 9600;
  805.            'D' : BaudRate := 19200;
  806.            'E' : BaudRate := 38400;
  807.            'F' : BaudRate := 57600;
  808.            'G' : ComPort := 1;
  809.            'H' : ComPort := 2;
  810.            'I' : begin
  811.                       ComPort := 3;
  812.                       HighComm := On;
  813.                  end;
  814.            'J' : begin
  815.                       ComPort := 4;
  816.                       HighComm := On;
  817.                  end;
  818.            'K' : Parity := 'E';   (* Goes with 7 Data Bits *)
  819.            'L' : Parity := 'S';
  820.            'M' : Parity := 'M';
  821.            'N' : Parity := 'N';   (* Goes with 8 Data Bits *)
  822.            'O' : Parity := 'O';
  823.            'P' : StopBits := 1;
  824.            'Q' : StopBits := 2;
  825.            'R' : DataBits := 7;   (* Word Size - For PC to Mainframe (IBM, UNIX) *)
  826.            'S' : DataBits := 8;   (* Word Size - For PC to PC *)
  827.            'T' : begin
  828.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  829.                     Install_Protocols(Config);
  830.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  831.                     WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  832.                  end;
  833.            'U' : begin
  834.                     SAVECONFIG(Config);
  835.                  end;
  836.            'V' : begin
  837.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  838.                     Setup(Config);
  839.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  840.                     WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  841.                  end;
  842.            'W' : begin
  843.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  844.                     Set_FilesPath(Config);
  845.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  846.                     WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  847.                  end;
  848.            'X' : begin
  849.                     WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  850.                     Define_Macros(Config);
  851.                     WINDOWIN(white,blue,4,2,2,78,22,CursorCol,CursorRow,WindowPtr);
  852.                  end;
  853.      END (* case *);
  854.      IF (ComPort > 2) and (HighComm = On) THEN
  855.         begin
  856.            SETSCREEN(yellow,blue,0,10,21,70,21);
  857.            WRITE('Enter com port base address (hex):  ');
  858.            textcolor(white);
  859.            readln(Com_Addr_Str);
  860.            Com_Addr := Hex_To_Dec(Com_Addr_Str,-1);
  861.            textcolor(yellow);
  862.            WRITE('Enter com port IRQ level (1 to 15):  ');
  863.            textcolor(white);
  864.            GetInt(Com_Irq,0);
  865.            textcolor(yellow);
  866.            WRITE('Enter com port interrupt vector number (hex):  ');
  867.            textcolor(white);
  868.            readln(TempStr);
  869.            Com_Int_No := Hex_To_Dec(TempStr,-1);
  870.            writeln;
  871.            window(3,3,77,21);
  872.          end;
  873.      goto Beginning;
  874.      END (* with *);
  875. END (* Configure_Menu *);
  876.  
  877. (************************************************************************)
  878.  
  879. PROCEDURE LoadConfig(VAR Config : ConfigRec;
  880.                      VAR Buffer : BufferRec);
  881. VAR Flag,
  882.     Lcv        : Integer;
  883.     CfgFile    : Text;
  884.     Counter,
  885.     YesNo      : Char;
  886.     dbool      : Boolean;
  887. BEGIN
  888.    DirectVideo := FALSE;           (* No direct screen writes *)
  889.    Clear_Config(Config);
  890.    SETSCREEN(white,black,0,1,1,80,25);
  891.    writeln;
  892.    writeln('                    SUN Comm  v1.0  -  Boyd C. Fletcher ');
  893.    writeln;
  894.    write('Load Config File (Y,N) ');
  895.    repeat
  896.          YesNo := Readkey;
  897.    until YesNo in ['Y','y','N','n'];
  898.    writeln;
  899.    if YesNo in ['Y','y']
  900.        then begin
  901.                  {$I-}
  902.                  assign(CfgFile,'SunCom.CFG');
  903.                  reset(CfgFile);
  904.                  {$I+}
  905.                  if IOResult <> 0
  906.                     then begin
  907.                               writeln(^G,'Config File NOT Found!',^G);
  908.                               delay(2000);
  909.                               Modem_Config_Menu(Config,Buffer);
  910.                               exit;
  911.                          end
  912.                     else begin
  913.                               close(CfgFile);
  914.                               write('Loading Load Setup'); {LOAD_SETUP}
  915.                          end;
  916.             end
  917.        else begin
  918.                  Modem_Config_Menu(Config,Buffer);
  919.                  exit;
  920.              end;
  921.   Assign(CfgFile, 'SunCom.CFG');
  922. {$I-}
  923.   Reset(CfgFile);
  924. {$I+}
  925.   if IOResult = 0 then
  926.   begin
  927.      with Config do
  928.      begin
  929.      readln(CfgFile,ComPort);
  930.      readln(CfgFile,BaudRate);
  931.      readln(CfgFile,Parity);
  932.      readln(CfgFile,DataBits);
  933.      readln(CfgFile,StopBits);
  934.      readln(CfgFile,LocalEcho);
  935.      readln(CfgFile,LineFeeds);
  936.      readln(CfgFile,ChatMode);
  937.      readln(CfgFile,MuteMode);
  938.      readln(CfgFile,InBufSize);
  939.      readln(CfgFile,OutBufSize);
  940.      readln(CfgFile,Do_XonXoff);
  941.      readln(CfgFile,Do_HardWired);
  942.      readln(CfgFile,Do_CTS);
  943.      readln(CfgFile,Do_DSR);
  944.      readln(CfgFile,Com_Addr_Str);
  945.      readln(CfgFile,Com_Addr);
  946.      readln(CfgFile,Com_IRQ);
  947.      readln(CfgFile,Com_INT_No);
  948.      readln(CfgFile,DirectScreen);
  949.      readln(CfgFile,Do_Async_Status);
  950.      readln(CfgFile,HideStatusBar);
  951.      for Counter := 'A' to 'G' do
  952.         begin
  953.            readln(CfgFile,Protocols[Counter].Name);
  954.            readln(CfgFile,Protocols[Counter].Up);
  955.            readln(CfgFile,Protocols[Counter].Down);
  956.            readln(CfgFile,Protocols[Counter].Flag);
  957.         end; {for}
  958.      readln(CfgFile,FilesPath);
  959.      for Lcv := 1 to Max do
  960.           begin
  961.                readln(CfgFile,FonBook[Lcv].Name);
  962.                readln(CfgFile,FonBook[Lcv].Number);
  963.           end;
  964.      if DirectScreen = On
  965.         then DirectVideo := TRUE
  966.         else DirectVideo := FALSE;
  967.      end; {with}
  968.      close(CfgFile);
  969.      dBool := Initialize(Config,Buffer);
  970.   end;
  971. END (* LoadConfig *);
  972.  
  973. (****************************************************************************)
  974.  
  975. PROCEDURE Dial(    Number     : Str30;
  976.                    Name       : Str30;
  977.                VAR RX,
  978.                    RY         : Integer;
  979.                VAR Config : ConfigRec);
  980. VAR PhoneNumber : Str30;
  981.     Question    : Char;
  982.     Lcv         : Integer;
  983. begin
  984.      write(' (T)one or (P)ulse: ');
  985.      Question := readkey;
  986.      Question := upcase(Question);
  987.      if Question = 'T'
  988.         then PhoneNumber := 'ATDT '
  989.         else PhoneNumber := 'ATDP ';
  990.      ONCURSOR;
  991.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  992.      SETSCREEN(white,black,0,1,1,80,24);
  993.      writeln('Dialing ',Name,' AT ',Number,'    Hit ''RETURN'' to Cancel.');
  994.      writeln;
  995.      RX := 1;
  996.      RY := 3;
  997.      PhoneNumber := PhoneNumber + Number + #13;
  998.      for Lcv := 1 to length(PhoneNumber) do
  999.          begin
  1000.                Async_Send_Now(PhoneNumber[Lcv]);
  1001.          end;
  1002.      delay(1000);
  1003. end;
  1004.  
  1005. (****************************************************************************)
  1006.  
  1007. PROCEDURE Phone_Book(VAR RX,
  1008.                          RY         : Integer;
  1009.                      VAR Config : ConfigRec);
  1010. VAR ExitOk,
  1011.     dbool       : Boolean;
  1012.     Counter,
  1013.     Index       : LongInt;
  1014.     Lcv         : Integer;
  1015.     Question    : Char;
  1016.     Number      : String[3];
  1017.     OldRec      : FonBookRec;
  1018.     PhoneNumber : Str30;
  1019. begin
  1020.      with Config do
  1021.      begin
  1022.      WINDOWIN(white,blue,4,5,2,75,24,CursorCol,CursorRow,WindowPtr);
  1023.      textcolor(yellow);
  1024.      writeln('  SUN Comm v1.0  -  Phone Book':50);
  1025.      LINE(196,69,white);
  1026.      window(6,20,74,23);
  1027.      LINE(196,69,white);
  1028.      textcolor(yellow);
  1029.      write('     (D)ial  (M)anual Dial  Make (Q)ueue  E(x)it  (E)dit  ',chr(24),chr(25));
  1030.      window(6,5,74,19);
  1031.      OFFCURSOR;
  1032.      Lcv := 1;
  1033.      Counter := 1;
  1034.      ExitOk := False;
  1035.      Question := '>';
  1036.      while (ExitOk = False) do
  1037.          begin
  1038.             if(Lcv <> 15)and(Question='>')
  1039.                  then begin
  1040.                            textcolor(white);
  1041.                            write(Counter:4,'. ');
  1042.                            textcolor(yellow);
  1043.                            writeln(FonBook[Counter].Name,'  ',FonBook[Counter].Number);
  1044.                       end;
  1045.               if (Lcv = 15)and(Question = '>')
  1046.                  then begin
  1047.                            textcolor(white);
  1048.                            write(Counter:4,'. ');
  1049.                            textcolor(yellow);
  1050.                            write(FonBook[Counter].Name,'  ',FonBook[Counter].Number);
  1051.                       end;
  1052.               if (Lcv = 15) then
  1053.                  begin
  1054.                       repeat until KeyPressed;
  1055.                       Question := Readkey;
  1056.                       if Question = #0 then
  1057.                          begin
  1058.                               Question := ReadKey;
  1059.                               if Question = #80
  1060.                                  then Question := '>';
  1061.                               if Question = #72
  1062.                                  then Question := '<';
  1063.                               if Question = #77
  1064.                                  then Question := ' ';
  1065.                               if Question = #73
  1066.                                  then Question := '<';
  1067.                               if Question = #81
  1068.                                  then Question := '>';
  1069.                               if Question = #71
  1070.                                  then begin
  1071.                                            Question := '>';
  1072.                                            Counter := 0;
  1073.                                       end;
  1074.                               if Question = #79
  1075.                                  then begin
  1076.                                            Question := '>';
  1077.                                            Counter := 135;
  1078.                                       end;
  1079.                          end;
  1080.                       if Question = #27
  1081.                          then Question := 'X';
  1082.                       Question := upcase(Question);
  1083.                       ONCURSOR;
  1084.                       if Question in ['Q','D','>','E','M','<','X','0'..'9'] then
  1085.                          begin
  1086.                               Case Question of
  1087.                                      '<' : Counter := Counter - 30;
  1088.                                      'M' : begin
  1089.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1090.                                                 write(' Manual Dial: ');
  1091.                                                 readln(PhoneNumber);
  1092.                                                 Dial(PhoneNumber,'Manual Dial',RX,RY,Config);
  1093.                                                 Exit;
  1094.                                             end;
  1095.                                      'Q' : begin
  1096.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1097.                                                 write(' Index Number(s): ');
  1098.                                                 readln(Number);
  1099.                                                 val(Number,Index,Lcv);
  1100.                                                 if (Index >= 1) and (Index <= 150)
  1101.                                                    then begin
  1102.                                                              OldRec := FonBook[Index];
  1103.                                                         end;
  1104.                                                 Counter := Counter - 15;
  1105.                                            end;
  1106.                                      'D' : begin
  1107.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1108.                                                 write(' Index Number: ');
  1109.                                                 readln(Number);
  1110.                                                 val(Number,Index,Lcv);
  1111.                                                 if (Index >= 1) and (Index <= 150) then
  1112.                                                     begin
  1113.                                                         Dial(FonBook[Index].Number,FonBook[Index].Name,RX,RY,Config);
  1114.                                                         Exit;
  1115.                                                     end;
  1116.                                                 Counter := Counter - 15;
  1117.                                             end;
  1118.                                      'E'  : begin
  1119.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1120.                                                 Counter := Counter - 15;
  1121.                                                 write(' Index Number: ');
  1122.                                                 readln(Number);
  1123.                                                 val(Number,Index,Lcv);
  1124.                                                 if (Index >= 1) and (Index <= 150)
  1125.                                                    then begin
  1126.                                                 OldRec := FonBook[Index];
  1127.                                                 write(' #',Index:3,' Name: ',FonBook[Index].Name);
  1128.                                                 window(18,23,48,23);
  1129.                                                 textcolor(red);
  1130.                                                 readln(FonBook[Index].Name);
  1131.                                                 if length(FonBook[Index].Name) <= 1 then FonBook[Index].Name := OldRec.Name;
  1132.                                                 if length(FonBook[Index].Name) < 30 then
  1133.                                                    begin
  1134.                                                         for Lcv := length(FonBook[Index].Name) to 30 do
  1135.                                                             begin
  1136.                                                                  FonBook[Index].Name := FonBook[Index].Name + ' ';
  1137.                                                             end; {for}
  1138.                                                    end;
  1139.                                                 textcolor(black);
  1140.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1141.                                                 write(' #',Index:3,' Number: ',FonBook[Index].Number);
  1142.                                                 window(20,23,50,23);
  1143.                                                 textcolor(red);
  1144.                                                 readln(FonBook[Index].Number);
  1145.                                                 if length(FonBook[Index].Number)<=1 then FonBook[Index].Number:=OldRec.Number;
  1146.                                                 end {if}
  1147.                                             end;
  1148.                                      'X' : ExitOk := True;
  1149.                              '1','2','3',
  1150.                              '4','5','6',
  1151.                              '7','8','9',
  1152.                              '0'         : begin
  1153.                                                 SETSCREEN(black,white,0,6,23,74,23);
  1154.                                                 write(' Index Number: ');
  1155.                                                 readln(Number);
  1156.                                                 val(Number,Index,Lcv);
  1157.                                                 if (Index >= 1) and (Index <= 150) then
  1158.                                                     begin
  1159.                                                         Dial(FonBook[Index].Number,FonBook[Index].Name,RX,RY,Config);
  1160.                                                         Exit;
  1161.                                                     end;
  1162.                                                 Counter := Counter - 15;
  1163.                                            end;
  1164.                               end; {case}
  1165.                               if Question in ['Q','D','>','<','E','M','X'] then
  1166.                                  begin
  1167.                                       Lcv := 0;
  1168.                                       Question := '>';
  1169.                                  end
  1170.                                  else begin
  1171.                                            Question := '>';
  1172.                                            Lcv := 0;
  1173.                                       end;
  1174.                               SETSCREEN(yellow,blue,0,6,23,74,23);
  1175.                               window(6,5,74,19);
  1176.                          end;
  1177.                       if Question in ['Q','D','>','<','E','M','X'] then
  1178.                          begin
  1179.                               Lcv := 0;
  1180.                               Question := '>';
  1181.                          end
  1182.                          else begin
  1183.                                    Question := '>';
  1184.                                    Counter := Counter - 15;
  1185.                                    Lcv := 0;
  1186.                               end;
  1187.                       clrscr;
  1188.                       OFFCURSOR;
  1189.                  end;
  1190.               if Question in ['>','<'] then
  1191.                  begin
  1192.                       Counter := Counter + 1;
  1193.                       Lcv := Lcv + 1;
  1194.                       if Counter > 150 then Counter := 1;
  1195.                       if Counter < 1 then Counter := 136;
  1196.                  end;
  1197.          end;
  1198.      end; {with}
  1199.      ONCURSOR;
  1200.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  1201. end;
  1202.  
  1203. (****************************************************************************)
  1204.  
  1205. PROCEDURE Finish_Communications;
  1206.  
  1207. BEGIN (* Finish_Communications *)
  1208.    Async_Close(FALSE);             (* Close port and drop DTR *)
  1209.    Async_Release_Buffers;          (* Release space allocated for buffers *)
  1210. END   (* Finish_Communications *);
  1211.  
  1212. (****************************************************************************)
  1213.  
  1214. Procedure Save_Buffer(VAR Buffer : BufferRec);
  1215. VAR Counter  : Integer;
  1216.     DataFile : Text;
  1217. begin
  1218.      with Buffer do begin
  1219.      {$I-}
  1220.      assign(DataFile,BufferFileName);
  1221.      reset(DataFile);
  1222.      {$I+}
  1223.      if IOResult <> 0
  1224.         then begin
  1225.                   assign(DataFile,BufferFileName);
  1226.                   rewrite(DataFile);
  1227.              end
  1228.         else begin
  1229.                   assign(DataFile,BufferFileName);
  1230.                   append(DataFile);
  1231.              end;
  1232.      for Counter := 1 to BufferCounter do
  1233.          begin
  1234.               write(DataFile,BufferArray[Counter]);
  1235.          end;
  1236.      close(DataFile);
  1237.      BufferCounter := 1;
  1238.      end; {with - Buffer}
  1239. end;
  1240.  
  1241. (****************************************************************************)
  1242.  
  1243. PROCEDURE Buffer_Menu(VAR Buffer : BufferRec);
  1244. VAR Question    : Char;
  1245.     OldFileName : String[12];
  1246. LABEL Beginning;
  1247. begin
  1248.      with Buffer do begin
  1249.      WINDOWIN(white,blue,4,25,9,55,20,CursorCol,CursorRow,WindowPtr);
  1250.      Beginning:
  1251.      SETSCREEN(white,blue,0,26,10,54,19);
  1252.      OFFCURSOR;
  1253.      textcolor(yellow);
  1254.      writeln('     Capture Buffer Menu');
  1255.      LINE(196,29,white);
  1256.      textcolor(yellow);
  1257.      writeln('      O - Open Buffer ');
  1258.      writeln('      C - Close Buffer');
  1259.      writeln('      S - Set Filename');
  1260.      LINE(196,29,white);
  1261.      textcolor(yellow);
  1262.      write(' Status  : ');
  1263.      textcolor(white);
  1264.      writeln(Open_Close[BufferStatus]);
  1265.      textcolor(yellow);
  1266.      write(' Filename: ');
  1267.      textcolor(white);
  1268.      writeln(BufferFileName);
  1269.      LINE(196,29,white);
  1270.      textcolor(lightgray);
  1271.      write('       ESC - To Exit');
  1272.      Question := readkey;
  1273.      if Question = ESC then
  1274.         begin
  1275.              ONCURSOR;
  1276.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  1277.              Exit;
  1278.         end;
  1279.      ONCURSOR;
  1280.      if Question in ['O','o','C','c','S','s']
  1281.         then case Question of
  1282.                  'O','o' : BufferStatus := On;
  1283.                  'C','c' : begin
  1284.                                 BufferStatus := Off;
  1285.                                 Save_Buffer(Buffer);
  1286.                                 Clear_Buffer(Buffer);
  1287.                            end;
  1288.                  'S','s' : begin
  1289.                                 OldFileName := BufferFileName;
  1290.                                 SETSCREEN(black,white,0,5,22,75,22);
  1291.                                 write(' Buffer Filename: ',BufferFileName);
  1292.                                 window(23,22,75,22);
  1293.                                 textcolor(red);
  1294.                                 readln(BufferFilename);
  1295.                                 if length(BufferFileName) <= 1
  1296.                                    then BufferFileName := OldFileName;
  1297.                                 SETSCREEN(black,black,0,5,22,75,22);
  1298.                            end;
  1299.              end; {case}
  1300.      goto Beginning;
  1301.      end; {with - Buffer}
  1302. end;
  1303.  
  1304. (****************************************************************************)
  1305.  
  1306. PROCEDURE Menu(    Ch         : Char;
  1307.                VAR RX,
  1308.                    RY         : Integer;
  1309.                VAR Config     : ConfigRec;
  1310.                VAR Buffer     : BufferRec;
  1311.                VAR ExitActive : Boolean);
  1312. VAR Question   : Char;
  1313.     dbool      : Boolean;
  1314.     HangUpStr  : String[10];
  1315.     Lcv        : Integer;
  1316. begin
  1317.      with Config do begin
  1318.      with Buffer do begin
  1319.      case Ch of
  1320.           #45 : begin
  1321.                      WINDOWIN(white,blue,4,25,10,55,12,CursorCol,CursorRow,WindowPtr);
  1322.                      textcolor(yellow);
  1323.                      write(' Exit - Are you sure (Y,N)? ');
  1324.                      Question := ReadKey;
  1325.                      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  1326.                      if Question in ['Y','y']
  1327.                         then ExitActive := True;
  1328.                 end;
  1329.           #16 : begin
  1330.                      OFFCURSOR;
  1331.                      WINDOWIN(white,blue,4,1,1,80,23,CursorCol,CursorRow,WindowPtr);
  1332.                      DisplayMenu;
  1333.                      MAKEWINDOW(white,blue,0,1,22,18,79,24);
  1334.                      writeln('ALT Q - This Screen (HELP SCREEN)');
  1335.                      SETSCREEN(lightcyan,blue,1,28,21,79,24);
  1336.                      ShowStackUsage;
  1337.                      repeat until KeyPressed;
  1338.                      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  1339.                      ONCURSOR;
  1340.                 end;
  1341.           #24 : begin
  1342.                      Modem_Config_Menu(Config,Buffer);
  1343.                      ShowPortStatus(Config,Buffer);
  1344.                 end;
  1345.           #47 : DIRECTORY(white,yellow,blue,4);
  1346.           #37 : DEFINE_MACROS(Config);
  1347.           #35 : begin
  1348.                      WINDOWIN(white,blue,4,23,10,57,12,CursorCol,CursorRow,WindowPtr);
  1349.                      textcolor(yellow);
  1350.                      write(' HANG UP - Are you sure (Y,N)? ');
  1351.                      Question := ReadKey;
  1352.                      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  1353.                      if Question in ['Y','y']
  1354.                         then begin
  1355.                                   OFFCURSOR;
  1356.                                   MAKEWINDOW(white,blue,4,0,23,10,57,12);
  1357.                                   textcolor(yellow);
  1358.                                   write('   ******* Hanging Up *******',^G);
  1359.                                   Async_Close(TRUE);
  1360.                                   Async_Release_Buffers;
  1361.                                   delay(2000);
  1362.                                   dbool := Initialize(Config,Buffer);
  1363.                                   delay(1000);
  1364.                                   if Async_Carrier_Detect = False
  1365.                                      then begin
  1366.                                                HangUpStr := 'ATH'+#13;
  1367.                                                For Lcv := 1 to length(HangUpStr) do
  1368.                                                  begin
  1369.                                                      Async_Send_Now(HangUpStr[Lcv]);
  1370.                                                  end;
  1371.                                                delay(1000);
  1372.                                                RX := 1;
  1373.                                                RY := 6;
  1374.                                           end;
  1375.                              end;
  1376.                      ONCURSOR;
  1377.                 end;
  1378.           #31 : begin
  1379.                      UPLOAD(Config);
  1380.                      ShowPortStatus(Config,Buffer);
  1381.                 end;
  1382.           #19 : begin
  1383.                      DOWNLOAD(Config);
  1384.                      ShowPortStatus(Config,Buffer);
  1385.                 end;
  1386.           #33 : begin
  1387.                      READ_FILE(Config);
  1388.                      ShowPortStatus(Config,Buffer);
  1389.                 end;
  1390.           #17 : begin
  1391.                      SETSCREEN(white,black,0,1,1,80,24);
  1392.                      RX := 1;
  1393.                      RY := 1;
  1394.                 end;
  1395.           #18 : begin
  1396.                      if LocalEcho = On
  1397.                         then LocalEcho := Off
  1398.                         else LocalEcho := On;
  1399.                      ShowPortStatus(Config,Buffer);
  1400.                 end;
  1401.           #38 : begin
  1402.                      if LineFeeds = On
  1403.                         then LineFeeds := Off
  1404.                         else LineFeeds := On;
  1405.                      ShowPortStatus(Config,Buffer);
  1406.                 end;
  1407.           #46 : begin
  1408.                      if ChatMode = On
  1409.                         then ChatMode := Off
  1410.                         else ChatMode := On;
  1411.                      ShowPortStatus(Config,Buffer);
  1412.                 end;
  1413.           #50 : begin
  1414.                      if MuteMode = On
  1415.                         then MuteMode := Off
  1416.                         else MuteMode := On;
  1417.                      ShowPortStatus(Config,Buffer);
  1418.                 end;
  1419.           #25 : begin
  1420.                      if BufferStatus = On
  1421.                         then begin
  1422.                                   BufferStatus := Pause;
  1423.                                   Save_Buffer(Buffer)
  1424.                              end
  1425.                         else BufferStatus := On;
  1426.                      ShowPortStatus(Config,Buffer);
  1427.                 end;
  1428.           #48 : begin
  1429.                      if ToggleBackSpace = On
  1430.                         then ToggleBackSpace := Off
  1431.                         else ToggleBackSpace := On;
  1432.                      ShowPortStatus(Config,Buffer);
  1433.                 end;
  1434.           #22 : begin
  1435.                      BUFFER_MENU(Buffer);
  1436.                      ShowPortStatus(Config,Buffer);
  1437.                 end;
  1438.           #44 : SHELL_TO_DOS;
  1439.           #32 : PHONE_BOOK(RX,RY,Config);
  1440.      end; {case}
  1441.      end; {with - Buffer}
  1442.      end; {with - config}
  1443. end;
  1444.  
  1445. (****************************************************************************)
  1446.  
  1447. PROCEDURE Send_Macro(VAR Config : ConfigRec;
  1448.                          Key : Char);
  1449. VAR SendStr,
  1450.     TempStr       : String;
  1451.     Lcv,
  1452.     Code,
  1453.     GraphicNum,
  1454.     Start         : Integer;
  1455. begin
  1456.      with Config.Macros do
  1457.      begin
  1458.      SendStr := ' ';
  1459.      case Key of
  1460.           #71 : SendStr := Home_Key;
  1461.           #79 : SendStr := End_Key;
  1462.           #72 : SendStr := Up_Key;
  1463.           #80 : SendStr := Down_Key;
  1464.           #75 : SendStr := Left_Key;
  1465.           #77 : SendStr := Right_Key;
  1466.           #73 : SendStr := PageUp_Key;
  1467.           #81 : SendStr := PageDown_Key;
  1468.           #82 : SendStr := Ins_Key;
  1469.           #83 : SendStr := Del_Key;
  1470.     end; {case}
  1471.     Start := 1;
  1472.     for Lcv := Start to length(SendStr) do
  1473.         begin
  1474.              if SendStr[Lcv] = '^' then
  1475.                 begin
  1476.                     Lcv := Lcv + 1;
  1477.                     Async_Send_Now(chr(Ctrl_Keys[SendStr[Lcv]]));
  1478.                 end
  1479.                 else if SendStr[Lcv] = '~' then
  1480.                         begin
  1481.                             delay(1500);
  1482.                         end
  1483.                         else if (SendStr[Lcv] = '#') and (SendStr[Lcv+1] = '#') then
  1484.                                 begin
  1485.                                     Lcv := Lcv + 2;
  1486.                                     TempStr := SendStr[Lcv]+SendStr[Lcv+1]+SendStr[Lcv+2];
  1487.                                     Lcv := Lcv + 2;
  1488.                                     val(TempStr,GraphicNum,Code);
  1489.                                     if Code <> 0
  1490.                                        then writeln(^G,'Error In Macro (',Key,') at position: ',Code)
  1491.                                        else Async_Send_Now(chr(GraphicNum));
  1492.                                 end
  1493.                                 else begin
  1494.                                           Async_Send_Now(SendStr[Lcv]);
  1495.                                           if Config.LocalEcho = On then write(SendStr[Lcv]);
  1496.                                      end;
  1497.         end; {for}
  1498.     end {with}
  1499. end;
  1500.  
  1501. (****************************************************************************)
  1502.  
  1503. PROCEDURE TermDisplay (    Ch        : Char;
  1504.                        VAR Config    : ConfigRec;
  1505.                            Direction : Byte);
  1506. begin
  1507.   if Ch = #9
  1508.      then begin
  1509.              write('     ');
  1510.              exit;
  1511.           end;
  1512.   if Config.ChatMode = Off
  1513.      then ANSIDRIVER(Ch)
  1514.      else if Direction = Send then
  1515.              begin
  1516.                   textcolor(white);
  1517.                   write(Ch);
  1518.              end
  1519.              else begin
  1520.                        textcolor(yellow);
  1521.                        write(Ch);
  1522.                   end;
  1523.   if (Ch = #13) and (Config.Linefeeds = On) then writeln;
  1524.   if (Ch = #12) then SETSCREEN(white,black,0,1,1,80,24);
  1525.   if Ch = #8 then write(' ',chr(8));
  1526. END (* TermDisplay *);
  1527.  
  1528. (****************************************************************************)
  1529.  
  1530. PROCEDURE Terminal(VAR Config : ConfigRec;
  1531.                    VAR Buffer : BufferRec);
  1532.  
  1533. VAR
  1534.    Sch        : Char;        (* Send Char    *)
  1535.    RCh        : Char;        (* Receive Char *)
  1536.    ExitOK     : Boolean;     (* Exit Flag    *)
  1537.    Bool       : Boolean;
  1538.    Question   : CHAR;
  1539.    RX,RY      : Integer;
  1540.  
  1541. BEGIN
  1542.    with Config do begin
  1543.    with Buffer do begin
  1544.    ExitOk := FALSE;
  1545.    ShowPortStatus(Config,Buffer);
  1546.    GotoXY(1,3);
  1547.    repeat
  1548.        IF KeyPressed THEN
  1549.            BEGIN
  1550.               Sch := ReadKey;
  1551.               if Sch = #0 then
  1552.                  begin
  1553.                       Sch := ReadKey;
  1554.                       RX := WhereX;
  1555.                       RY := WhereY;
  1556.                       if Sch in [#79,#72,#80,#75,#77,#73,#81,#82,#83]
  1557.                          then Send_Macro(Config,Sch)
  1558.                          else Menu(Sch,RX,RY,Config,Buffer,ExitOK);
  1559.                       if HideStatusbar = Off
  1560.                          then SetScreen(white,black,1,1,1,80,24)
  1561.                          else SetScreen(white,black,1,1,1,80,25);
  1562.                       gotoxy(RX,RY);
  1563.                  end
  1564.         else begin
  1565.                 if (ToggleBackSpace = On) and (Sch = #8)
  1566.                    then Async_Send_Now(chr(127))
  1567.                    else Async_Send_Now(Sch);
  1568.                 if LocalEcho = On then TermDisplay(Sch,Config,Send);
  1569.              end;
  1570.         end;
  1571.       IF Async_Receive(Rch) THEN
  1572.          case ORD(Rch) of
  1573.             0: ;
  1574.             7: if MuteMode = Off
  1575.                   then TermDisplay(Rch,Config,Receive)
  1576.                   else write('<BEL>')
  1577.             else begin
  1578.                       if (BufferStatus = On) and (BufferCounter <= MaxBufferLimit) and (LocalEcho = Off)
  1579.                          then begin
  1580.                                  BufferArray[BufferCounter] := Rch;
  1581.                                  BufferCounter := BufferCounter + 1;
  1582.                               end
  1583.                          else if (BufferStatus = On) and (BufferCounter > MaxBufferLimit)
  1584.                                  then Save_Buffer(Buffer);
  1585.                       TermDisplay(Rch,Config,Receive);
  1586.                  end;
  1587.          end;{case}
  1588.    until (ExitOK = True);
  1589.    end; {with - Buffer}
  1590.    end {with - Config}
  1591. END;
  1592.  
  1593. (****************************************************************************)
  1594.  
  1595. PROCEDURE Main;
  1596.  
  1597. VAR Config : ConfigRec;
  1598.     Buffer : BufferRec;
  1599. BEGIN
  1600.    LoadConfig(Config,Buffer);
  1601.    IF Initialize(Config,Buffer) then
  1602.       BEGIN
  1603.          Terminal(Config,Buffer);
  1604.          Finish_Communications;
  1605.       END;
  1606.    clrscr;
  1607. END;
  1608.  
  1609. BEGIN
  1610.      Main;
  1611.      ShowStackUsage;
  1612. END.
  1613.