home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / suncom.zip / SUNINC.INC < prev    next >
Text File  |  1990-02-24  |  17KB  |  538 lines
  1.  
  2. (************************************************************************)
  3.  
  4. PROCEDURE Line(LineChr,
  5.                LineLength,
  6.                Color       : Integer);
  7. VAR Counter : Integer;
  8. begin
  9.      textcolor(Color);
  10.      for Counter := 1 to LineLength do
  11.          begin
  12.               write(chr(LineChr));
  13.          end;
  14. end;
  15.  
  16. (****************************************************************************)
  17.  
  18. FUNCTION ReadPause  : Boolean;
  19. VAR x,y      : Integer;
  20.     Question : Char;
  21. LABEL Beginning;
  22. begin
  23.      while keypressed do
  24.           begin
  25.                X := whereX;
  26.                Y := whereY;
  27.                SETSCREEN(lightred+blink,black,0,65,1,79,1);
  28.                OFFCURSOR;
  29.                write('FILE PAUSED.');
  30.                Beginning:
  31.                Question := ReadKey;
  32.                if Question = #27
  33.                   then begin
  34.                             READPAUSE := TRUE;
  35.                             exit;
  36.                        end;
  37.                if Question <> #13 then goto Beginning;
  38.                ONCURSOR;
  39.                SETSCREEN(white,black,0,65,1,79,1);
  40.                SETSCREEN(white,black,1,1,2,79,25);
  41.                gotoxy(X,Y);
  42.                READPAUSE := FALSE;
  43.           end;
  44. end;
  45.  
  46. (*****************************************************************************)
  47.  
  48. PROCEDURE LIST_TO_PRINTER(FileName : String);
  49.  
  50. CONST
  51.   PageWidth = 80;
  52.   PrintLength = 55;
  53.   PathLength  = 65;
  54.   FormFeed = #12;
  55.   VerticalTabLength = 3;
  56.  
  57. TYPE
  58.   WorkString  = String[126];
  59.  
  60. VAR
  61.   CurRow      : Integer;
  62.   MainFile    : Text;
  63.  
  64. {---------------------------------------------------------------------------}
  65.  
  66. PROCEDURE VerticalTab;
  67. VAR i: integer;
  68. begin
  69.     for i := 1 to VerticalTabLength do Writeln(LST);
  70. end {vertical tab};
  71.  
  72. {---------------------------------------------------------------------------}
  73.  
  74. PROCEDURE ProcessLine(PrintStr: WorkString);
  75. begin
  76.     CurRow := Succ(CurRow);
  77.     if Length(PrintStr) > PageWidth then Inc(CurRow);
  78.     if CurRow > PrintLength then
  79.     begin
  80.       Write(LST,FormFeed);
  81.       VerticalTab;
  82.       CurRow := 1;
  83.     end;
  84.     Writeln(LST,PrintStr);
  85. end {Process line};
  86.  
  87. {---------------------------------------------------------------------------}
  88.  
  89. PROCEDURE ProcessFile(FileName : string);
  90.   { This procedure displays the contents of the File to the Printer }
  91.  
  92. VAR
  93.     LineBuffer: WorkString;
  94.  
  95. begin  {Process File}
  96.     VerticalTab;
  97.     while not EOF(mainfile) do
  98.     begin
  99.       Readln(MainFile,LineBuffer);
  100.       ProcessLine(LineBuffer);
  101.       if READPAUSE = TRUE then Exit;
  102.     end;
  103.     Close(MainFile);
  104.     Write(LST,FormFeed); { move the printer to the beginning of the next }
  105.                          { page }
  106. end {Process File};
  107.  
  108. {---------------------------------------------------------------------------}
  109. begin {List_To_Printer}
  110.   CurRow := 0;
  111.   assign(MainFile,FileName);
  112.   reset(MainFile);
  113.   ProcessFile(FileName);
  114. end; {List_To_Printer}
  115.  
  116. (****************************************************************************)
  117.  
  118. PROCEDURE Read_File(VAR Config : ConfigRec);
  119. VAR Source          : String;
  120.     Chars,
  121.     Mode,
  122.     Question        : Char;
  123.     DataFile        : File of Char;
  124.     Modem,
  125.     dbool           : Boolean;
  126. begin
  127.      WINDOWIN(white,blue,4,10,10,70,12,CursorCol,CursorRow,WindowPtr);
  128.      textcolor(yellow);
  129.      write(' Read Filename: ');
  130.      textcolor(white);
  131.      readln(Source);
  132.      if length(Source) = 0 then
  133.         begin
  134.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  135.              exit;
  136.         end;
  137.      textcolor(yellow);
  138.      SETSCREEN(black,black,0,10,10,70,12);
  139.      MAKEWINDOW(white,blue,4,0,25,10,55,16);
  140.      OFFCURSOR;
  141.      textcolor(yellow);
  142.      writeln('    Select Display Device');
  143.      LINE(196,29,white);
  144.      textcolor(yellow);
  145.      writeln('         S - Screen ');
  146.      writeln('         P - Printer');
  147.      write('         M - Modem  ');
  148.      Mode := ReadKey;
  149.      Mode := UpCase(Mode);
  150.      ONCURSOR;
  151.      if not(Mode in ['M','P'])
  152.         then Mode := 'S';
  153.      if Mode = 'M'
  154.         then Modem := True
  155.         else Modem := False;
  156.      SETSCREEN(white,black,0,1,1,80,25);
  157.      SETSCREEN(white,black,0,1,1,80,1);
  158.      write('Printing File: ');
  159.      textcolor(yellow);
  160.      write(Source);
  161.      textcolor(white);
  162.      write('     Mode: ');
  163.      textcolor(yellow);
  164.      case Mode of
  165.          'M' : write('Modem  ');
  166.          'S' : write('Screen ');
  167.          'P' : write('Printer');
  168.      end; {case}
  169.      SETSCREEN(white,black,0,1,2,80,25);
  170.      write('Press ENTER when Ready or ESC to Exit.');
  171.      Question := readkey;
  172.      if Question = #27 then
  173.         begin
  174.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  175.              exit;
  176.         end;
  177.      clrscr;
  178.      assign(DataFile,Source);
  179.      {$I-}
  180.      reset(DataFile);
  181.      {$I+}
  182.      if IOResult <> 0 then
  183.         begin
  184.              MAKEWINDOW(yellow,red,4,0,31,11,49,13);
  185.              textcolor(white+blink);
  186.              OFFCURSOR;
  187.              write(' File Not Found!',^G);
  188.              repeat until KeyPressed;
  189.              ONCURSOR;
  190.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  191.              exit;
  192.         end;
  193.      if Mode = 'P'
  194.         then begin
  195.                   LIST_TO_PRINTER(Source);
  196.                   SETSCREEN(red,white,0,1,1,80,1);
  197.                   write('                   Printing Completed. Press Any Key.');
  198.                   Question := readkey;
  199.                   WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  200.                   exit;
  201.              end;
  202.      while not eof(DataFile) do
  203.          begin
  204.               read(DataFile,Chars);
  205.               ANSIDRIVER(Chars);
  206.               if Modem = True
  207.                  then begin
  208.                            Async_Send(Chars);
  209.                            delay(10);
  210.                       end;
  211.               if READPAUSE = True
  212.                  then begin
  213.                            WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  214.                            exit;
  215.                       end;
  216.          end;
  217.      close(DataFile);
  218.      SETSCREEN(red,white,0,1,1,80,1);
  219.      write('                   Printing Completed. Press Any Key.');
  220.      Question := readkey;
  221.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  222. end;
  223.  
  224. (****************************************************************************)
  225.  
  226. PROCEDURE ReturnBeep(VAR Config : ConfigRec);
  227. VAR Lcv : Byte;
  228. begin
  229.     Lcv := 0;
  230.     if Config.MuteMode = Off
  231.        then
  232.            repeat
  233.               Sound(500);
  234.               delay(50);
  235.               Sound(1000);
  236.               delay(50);
  237.               Lcv := Lcv + 1;
  238.            until KeyPressed or (Lcv = 30);
  239.     nosound;
  240. end;
  241.  
  242. (************************************************************************)
  243. (*         Hex_To_Dec --- Convert hex string to decimal number          *)
  244. (************************************************************************)
  245.  
  246. FUNCTION Hex_To_Dec( S : AnyStr; Default : Integer ) : Integer;
  247.  
  248. (************************************************************************)
  249. (*                                                                      *)
  250. (*     Function:   Hex_To_Dec                                           *)
  251. (*                                                                      *)
  252. (*     Purpose:    Convert hex string to decimal number                 *)
  253. (*                                                                      *)
  254. (*     Calling Sequence:                                                *)
  255. (*                                                                      *)
  256. (*        Integ := Hex_To_Dec( S: AnyStr; Default: Integer ) : Integer; *)
  257. (*                                                                      *)
  258. (*           S       --- the hex string                                 *)
  259. (*           Default --- value to return if S not hex string            *)
  260. (*           Integ   --- corresponding decimal Integer (0 if bad)       *)
  261. (*                                                                      *)
  262. (************************************************************************)
  263.  
  264. VAR
  265.    I  : Integer;
  266.    Sum: Integer;
  267.  
  268. BEGIN (* Hex_To_Dec *)
  269.    Sum        := 0;
  270.    Hex_To_Dec := Default;
  271.    FOR I := 1 TO LENGTH( S ) DO
  272.       CASE S[I] OF
  273.          '0'..'9':  Sum := Sum * 16 + ( ORD(S[I]) - ORD('0') );
  274.          'A'..'F':  Sum := Sum * 16 + ( ORD(S[I]) - ORD('A') + 10 );
  275.          ELSE       EXIT;
  276.       END;
  277.    Hex_To_Dec := Sum;
  278. END   (* Hex_To_Dec *);
  279.  
  280. (************************************************************************)
  281.  
  282. PROCEDURE DisplayMenu;
  283. begin
  284.      textcolor(yellow);
  285.      writeln('                    SunCom v1.0  -  By Boyd C. Fletcher IV');
  286.      LINE(196,78,white);
  287.      writeln;
  288.      writeln('                                HELP MENU');
  289.      writeln;
  290.      writeln;
  291.      textcolor(white);
  292.      writeln('      ALT X                             ALT L ');
  293.      writeln('      ALT O                             ALT D ');
  294.      writeln('      ALT F                             ALT H ');
  295.      writeln('      ALT V                             ALT C ');
  296.      writeln('      ALT W                             ALT M ');
  297.      writeln('      ALT E                             ALT K ');
  298.      writeln('      ALT S                             ALT R ');
  299.      writeln('      ALT Z                             ALT B ');
  300.      writeln('      ALT U                             ALT P ');
  301.      MAKEWINDOW(yellow,blue,0,1,13,7,79,23);
  302.      writeln('- Exit SunCom');
  303.      writeln('- Configure');
  304.      writeln('- Read a Text File');
  305.      writeln('- Directory');
  306.      writeln('- Clear Screen');
  307.      writeln('- Toggle Echo ON/OFF');
  308.      writeln('- Upload / Send');
  309.      writeln('- Shell To Dos');
  310.      writeln('- Capture Buffer Menu');
  311.      MAKEWINDOW(yellow,blue,0,1,48,7,79,23);
  312.      writeln('- Toggle Linefeeds ON/OFF');
  313.      writeln('- Phone Book');
  314.      writeln('- Hang Up');
  315.      writeln('- Toggle Chat Mode ON/OFF');
  316.      writeln('- Toggle Mute Mode ON/OFF');
  317.      writeln('- Define Macro Keys');
  318.      writeln('- Download / Receive');
  319.      writeln('- Toggle Backspace ^H/<DEL>');
  320.      writeln('- Toggle Buffer Pause ON/OFF');
  321.      writeln;
  322.      MAKEWINDOW(white,blue,0,1,22,18,79,23);
  323.      writeln('ALT Q - This Screen (HELP SCREEN)');
  324. end;
  325.  
  326. (****************************************************************************)
  327.  
  328. PROCEDURE Upload(VAR Config : ConfigRec);
  329. VAR Source,
  330.     Message,
  331.     WkStr,
  332.     FileName   : String[80];
  333.     LCV        : Integer;
  334.     Counter,
  335.     Choice     : Char;
  336.     ProtoList  : Set of 'A'..'Z';
  337.     dBool      : Boolean;
  338. LABEL Beginning;
  339. begin
  340.      WINDOWIN(white,blue,4,10,10,70,12,CursorCol,CursorRow,WindowPtr);
  341.      FileName := ' ';
  342.      textcolor(yellow);
  343.      write('Upload FileName: ');
  344.      textcolor(white);
  345.      readln(FileName);
  346.      if length(FileName) = 0 then
  347.         begin
  348.              WRITELN(^g);
  349.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  350.              exit;
  351.         end;
  352.      SETSCREEN(white,black,0,1,1,80,24);
  353.      MAKEWINDOW(white,blue,4,0,20,3,60,22);
  354.      textcolor(yellow);
  355.      writeln('         Select Upload Protocol');
  356.      LINE(196,39,white);
  357.      textcolor(yellow);
  358.      writeln;
  359.      ProtoList := [];
  360.      with Config do
  361.      begin
  362.      for Counter := 'A' to 'G' do
  363.         begin
  364.            writeln(Counter:10,' - ',Protocols[Counter].Name);
  365.            if Protocols[Counter].Flag = 1 then ProtoList := ProtoList + [Counter];
  366.         end; {for}
  367.      writeln;
  368.      LINE(196,39,white);
  369.      textcolor(yellow);
  370.      writeln('         Z - Internal Zmodem');
  371.      LINE(196,39,white);
  372.      textcolor(lightgray);
  373.      writeln;
  374.      writeln('       ESC - To Exit');
  375.      textcolor(yellow);
  376.      writeln;
  377.      write('   Select: ');
  378.      Choice := Readkey;
  379.      Choice := Upcase(Choice);
  380.      if Choice in (ProtoList + ['Z']) then
  381.         begin
  382.              Source := ' /C ' + Protocols[Choice].Up
  383.         end
  384.         else begin
  385.                   WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  386.                   exit;
  387.              end;
  388.     str(BaudRate,WkStr);
  389.     CASE ComPort OF
  390.        1 : Message := Source + ' ' + WkStr + ' 1 ' + FileName;
  391.        2 : Message := Source + ' ' + WkStr + ' 2 ' + FileName;
  392.        3 : Message := Source + ' ' + WkStr + ' 3 ' + FileName;
  393.        4 : Message := Source + ' ' + WkStr + ' 4 ' + FileName;
  394.     end; {case}
  395.     SETSCREEN(white,black,0,1,1,80,25);
  396.     writeln('Sending File ',FileName);
  397.     writeln(message);
  398.     chdir(Config.FilesPath);
  399.     if Choice = 'Z' then
  400.        begin
  401.             WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  402.             dBool := Zmodem_Send(FileName,TRUE,ComPort,BaudRate);
  403.             ReturnBeep(Config);
  404.        end
  405.        else begin
  406.                  swapvectors;
  407.                  exec(getenv('comspec'),Message);
  408.                  swapvectors;
  409.                  writeln;
  410.                  write('Press ENTER to return to SunCom.');
  411.                  ReturnBeep(Config);
  412.                  WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  413.             end;
  414.     end; {with}
  415. end;
  416.  
  417. (****************************************************************************)
  418.  
  419. PROCEDURE Download(VAR Config : ConfigRec);
  420. VAR Source,
  421.     Message,
  422.     WkStr,
  423.     DirPath    : String[80];
  424.     LCV        : Integer;
  425.     Counter,
  426.     Choice     : Char;
  427.     ProtoList  : Set of 'A'..'Z';
  428.     dBool      : Boolean;
  429. LABEL Beginning;
  430. begin
  431.      WINDOWIN(white,blue,4,10,10,70,12,CursorCol,CursorRow,WindowPtr);
  432.      DirPath := ' ';
  433.      textcolor(yellow);
  434.      write('Download Path: ');
  435.      textcolor(white);
  436.      readln(DirPath);
  437.      if length(DirPath) = 0 then
  438.         begin
  439.              WRITELN(^g);
  440.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  441.              exit;
  442.         end;
  443.      SETSCREEN(white,black,0,1,1,80,24);
  444.      {$I-}
  445.      chdir(DirPath);
  446.      {$I+}
  447.      if (length(DirPath) = 2) and (DirPath[2] = ':')
  448.         then DirPath := DirPath + '\'
  449.         else if DirPath[length(DirPath)] = '\'
  450.                 then delete(DirPath,Length(DirPath),1);
  451.      if IOresult <> 0 then
  452.         begin
  453.              MAKEWINDOW(white,red,4,0,22,9,57,11);
  454.              textcolor(yellow);
  455.              write(' Disk Error - Invalid Directory! '^G^G);
  456.              delay(3500);
  457.              WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  458.              exit;
  459.         end;
  460.      MAKEWINDOW(white,blue,4,0,20,3,60,22);
  461.      textcolor(yellow);
  462.      writeln('        Select Download Protocol');
  463.      LINE(196,39,white);
  464.      textcolor(yellow);
  465.      writeln;
  466.      ProtoList := [];
  467.      with Config do
  468.      begin
  469.      for Counter := 'A' to 'G' do
  470.         begin
  471.            writeln(Counter:10,' - ',Protocols[Counter].Name);
  472.            if Protocols[Counter].Flag = 1 then ProtoList := ProtoList + [Counter];
  473.         end; {for}
  474.      writeln;
  475.      LINE(196,39,white);
  476.      textcolor(yellow);
  477.      writeln('         Z - Internal Zmodem');
  478.      LINE(196,39,white);
  479.      textcolor(lightgray);
  480.      writeln;
  481.      writeln('       ESC - To Exit');
  482.      textcolor(yellow);
  483.      writeln;
  484.      write('   Select: ');
  485.      Choice := Readkey;
  486.      Choice := Upcase(Choice);
  487.      if Choice in (ProtoList + ['Z']) then
  488.         begin
  489.              Source := ' /C ' + Protocols[Choice].Down
  490.         end
  491.         else begin
  492.                   WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  493.                   exit;
  494.              end;
  495.     str(BaudRate,WkStr);
  496.     CASE ComPort OF
  497.        1 : Message := Source + ' ' + WkStr + ' 1 ';
  498.        2 : Message := Source + ' ' + WkStr + ' 2 ';
  499.        3 : Message := Source + ' ' + WkStr + ' 3 ';
  500.        4 : Message := Source + ' ' + WkStr + ' 4 ';
  501.     end; {case}
  502.     SETSCREEN(white,black,0,1,1,80,25);
  503.     writeln('Receiving Files to Directory ',DirPath);
  504.     chdir(Config.FilesPath);
  505.     if Choice = 'Z' then
  506.        begin
  507.             WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  508.             dBool := Zmodem_Receive(DirPath,ComPort,BaudRate);
  509.             ReturnBeep(Config);
  510.        end
  511.        else begin
  512.                  swapvectors;
  513.                  exec(getenv('comspec'),Message);
  514.                  swapvectors;
  515.                  writeln;
  516.                  write('Press ENTER to return to SunCom.');
  517.                  ReturnBeep(Config);
  518.                  WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  519.             end;
  520.     end; {with}
  521. end;
  522.  
  523. (****************************************************************************)
  524.  
  525. PROCEDURE Shell_To_Dos;
  526. begin
  527.      WINDOWIN(white,blue,0,1,1,80,25,CursorCol,CursorRow,WindowPtr);
  528.      SETSCREEN(white,black,0,1,1,80,25);
  529.      writeln('Type EXIT to return to HandyComm.');
  530.      swapvectors;
  531.      exec(getenv('comspec'),' /C prompt $p$g');
  532.      exec(getenv('comspec'),'');
  533.      swapvectors;
  534.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  535. end;
  536.  
  537. (****************************************************************************)
  538.