home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / p / prot018s.zip / TERM.PAS < prev   
Pascal/Delphi Source File  |  1993-01-07  |  13KB  |  511 lines
  1.  
  2. { MiniTerminal program - to show the useage of the Protocol Engine.       }
  3. { (C) 1992 Mark Dignam - OmenTronics - Perth Omen BBS - 3:690/660@fidonet }
  4. {
  5.  
  6.  This is a very simple terminal program that I threw together to show you
  7.  just how easy the ProtEng unit is to use.
  8.  
  9.  It may or may not work on your system. It is only written to take up space
  10.  on your hard disk.
  11.  
  12.  Known Bugs.
  13.    Don't select a Com port that doesn't exist while using a Fossil driver.
  14.    For some reason this locks the system up!
  15.  
  16.  
  17. }
  18. {$M 16384,0,150000}
  19.  
  20. Uses
  21.   Dos,crt,ProtComm,Proteng,Ansi_Drv;
  22.  
  23. Type
  24.       scr          = array[1..2000] of
  25.                        record
  26.                           character : char;
  27.                           attribute : byte;
  28.                        end;
  29.  
  30.       scrprt       = ^scr;
  31.  
  32.  
  33. Const
  34.   BoxCol    = White + (Blue * 16);
  35.   TextCol   = LightCyan;
  36.   Baudrates : Array[1..9] of longint = (150,300,600,1200,2400,4800,9600,19200,38400);
  37.   Version   = 'v0.01';
  38. var
  39.   Finish,Doorway         : Boolean;
  40.   DownDir                : String[64];
  41.   scrbuff,
  42.   savescreen             : scrprt;
  43.   OldX,Oldy,BoxW,
  44.   OldText,Lines,
  45.   CurBaud,Curport        : Byte;
  46.   Regs                   : Registers;
  47.  
  48.  
  49. procedure OnCursor;
  50. begin
  51.   Regs.ax := 1 shl 8;
  52.   Regs.cx := 6 shl 8 + 7;
  53.   intr($10,Regs);
  54. end;
  55.  
  56. procedure OffCursor;
  57. begin
  58.   Regs.ax := 1 shl 8;
  59.   Regs.cx := 14 shl 8;
  60.   intr($10,Regs);
  61. end;
  62.  
  63. Function GetPath( Thepath : String) : String;
  64.  
  65. var
  66.   n     : NameStr;
  67.   e     : ExtStr;
  68.   d     : DirStr;
  69. begin
  70.   Fsplit(Thepath,d,n,e);
  71.   Getpath := d;
  72. end;
  73.  
  74. procedure position(x,y,col : byte; ch : char);
  75. var
  76.   i : word;
  77. begin
  78.   i := ((((y - 1) * 80) + (x - 1)) + 1);
  79.   scrbuff^[i].attribute := col;
  80.   scrbuff^[i].character := ch;
  81. end;
  82.  
  83. Procedure Save_Screen;
  84.  
  85. begin
  86.   Oldx := Wherex;
  87.   OldY := wherey;
  88.   OldText := TextAttr;
  89.   if (mem[0000:$0449] = $7) then
  90.      scrbuff := ptr($b000,0000)
  91.   else
  92.      scrbuff := ptr($b800,0000);
  93.   if memavail >= sizeof(scr) then
  94.     begin
  95.        New(SaveScreen);
  96.        savescreen^ := scrbuff^;
  97.     end
  98.   else
  99.     begin
  100.       writeln('Can''t allocate memory for screen image');
  101.       halt(1);
  102.     end;
  103.     OnCursor;
  104. end;
  105.  
  106.  
  107.  
  108. procedure make_window(x1,y1,x2,y2,col,btype : byte);
  109.  
  110. Const
  111.   tl : string[5] = '┌╓╒╔+';  tr : string[5] = '┐╖╕╗+';
  112.   bl : string[5] = '└╙╘╚+';  br : string[5] = '┘╜╛╝+';
  113.   hs : string[5] = '──══-';  vs : string[5] = '│║│║|';
  114.  
  115. var
  116.    i : word;
  117.    temp : String[80];
  118.  
  119. begin
  120.   Save_Screen;
  121.   OffCursor;
  122.   position(x1,y1,col,tl[btype]);
  123.   position(x2,y1,col,tr[btype]);
  124.   position(x1,y2,col,bl[btype]);
  125.   position(x2,y2,col,br[btype]);
  126.   for i := (x1 + 1) to (x2 - 1) do
  127.     begin
  128.       position(i,y1,col,hs[btype]);
  129.       position(i,y2,col,hs[btype]);
  130.     end;
  131.   for i := (y1 + 1) to (y2 - 1) do
  132.     begin
  133.       position(x1,i,col,vs[btype]);
  134.       position(x2,i,col,vs[btype]);
  135.     end;
  136.   fillchar(temp[1],x2-x1-1,32);
  137.   temp[0] := chr(x2-x1-1);
  138.   textAttr := BoxCol;
  139.   for i := (y1 + 1) to (y2 - 1) do
  140.     begin
  141.      gotoxy(x1+1,i);
  142.      Write(temp);
  143.     end;
  144.   window(x1 + 1,y1 + 1,x2 - 1,y2 - 1);
  145.  
  146. end;
  147.  
  148. procedure Remove_Window;
  149. begin
  150.   scrbuff^ := savescreen^;
  151.   dispose(Savescreen);
  152.   Window(1,1,80,25);
  153.   TextAttr := OldText;
  154.   Gotoxy(OldX,OldY);
  155.   OnCursor;
  156. end;
  157.  
  158. Procedure popup(Message : String);
  159.  
  160. Var
  161.   i,j    : Byte;
  162.  
  163. Begin
  164.   i := Length(message);
  165.   j := 40 - (i shr 1);
  166.   make_window(j-2,10,j+i+1,12,White + (blue * 16),1);
  167.   GotoXy(2,1);
  168.   Write(message);
  169.   Delay(500);
  170.   Remove_Window;
  171. end;
  172.  
  173. Procedure PopupLines(Message : String; MaxLines,MaxWidth : Byte);
  174.  
  175. Var
  176.   i,j    : Byte;
  177.  
  178. Begin
  179.   If (MaxLines > 0) and (maxlines < 25) then
  180.      Begin
  181.         Boxw := MaxWidth;
  182.         i := Boxw Div 2;
  183.         j := 40 - i;
  184.         make_window(j-2,8,j+Boxw+1,10+MaxLines,white + (Blue* 16),1);
  185.         Lines := 1;
  186.      end;
  187.   i := (Boxw - length(Message)) Div 2;
  188.   Gotoxy(2 + i,Lines);
  189.   Inc(Lines);
  190.   Write(message);
  191. end;
  192.  
  193. Procedure Currentsettings;
  194.  
  195. var
  196.    temp1,temp2  : String;
  197.  
  198. Begin
  199.  Str(Baudrates[curbaud],temp1);
  200.  Str(CurPort,temp2);
  201.  Popup('Current Baud rate is '+temp1+' using comm port '+temp2);
  202. end;
  203.  
  204. Procedure ShowHelp;
  205. var
  206.   ch : char;
  207.    temp1,temp2  : String;
  208.  
  209. Begin
  210.  Str(Baudrates[curbaud],temp1);
  211.  Str(CurPort,temp2);
  212. PopupLines('The Help Screen for Term',12,40);
  213. PopupLines('──────────────────────────────────────',0,0);
  214. PopupLines('Alt_X - Exit',0,0);
  215. PopupLines('Alt_J - Dos Shell',0,0);
  216. PopupLines('Alt_B - change baud rate',0,0);
  217. PopupLines('Alt_P - change Comm port',0,0);
  218. PopupLines('Alt_H - Drop Dtr and hang up',0,0);
  219. PopupLines('PageUp - UpLoad file to remote',0,0);
  220. Popuplines('PageDown - Download file from remote',0,0);
  221. PopupLines('──────────────────────────────────────',0,0);
  222. PopupLines('Speed is '+temp1+' baud - Port is '+Temp2,0,0);
  223. PopupLines('──────────────────────────────────────',0,0);
  224. PopupLines('Hit Any Key',0,0);
  225. ch := readkey;
  226. remove_Window;
  227. end;
  228.  
  229. Procedure HangUp;
  230.  
  231. begin
  232.  Comm_Dtr_off;
  233.  Delay(1000);
  234.  Comm_Dtr_On;
  235. end;
  236.  
  237. Procedure SetPort;
  238. var
  239.  GoodPort    : Boolean;
  240.  
  241. begin
  242.   Inc(Curport);
  243.   If Curport = 5 then curport := 1;
  244.   repeat
  245.     Comm_Deinit;
  246.     Goodport := comm_init(BaudRates[CurBaud],CurPort);
  247.     If Not Goodport Then Inc(CurPort);
  248.     If Curport = 5 then curport := 1;
  249.   Until Goodport;
  250.   CurrentSettings;
  251. end;
  252.  
  253. Procedure SetBaudRate;
  254. begin
  255.    Inc(Curbaud);
  256.    if Curbaud > 9 then Curbaud := 1;
  257.    Comm_SetDirect(BaudRates[CurBaud]);
  258.    Currentsettings;
  259. end;
  260.  
  261. Procedure UpLoadfiles;
  262.  
  263. var
  264.   Ch                   : Char;
  265.   Fname,temp1,temp2    : String;
  266.   temp3                : Str64;
  267.   GoodFile             : Boolean;
  268.   Sr                   : SearchRec;
  269.   i,j                  : Byte;
  270.   GotMem               : Boolean;
  271.  
  272. begin
  273.   PopupLines('Uploading - ',5,20);
  274.   Popuplines('<X> - XModem  ',0,0);
  275.   Popuplines('<1> - 1KXmodem',0,0);
  276.   Popuplines('<Y> - YModem  ',0,0);
  277.   Popuplines('<Z> - ZModem  ',0,0);
  278.   Popuplines('<P> - Yapp    ',0,0);
  279.   Ch := readKey;
  280.   ch := upcase(ch);
  281.   Remove_Window;
  282.   If (ch in ['X','1','Y','Z','P','G','S']) then
  283.        begin
  284.          ClearNameList;
  285.          Popuplines('',2,74);
  286.          PopUpLines('Filename(s) to send ->____________________________________________________',0,0);
  287.          Gotoxy(24,2);
  288.          OnCursor;
  289.          Readln(fname);
  290.          Remove_Window;
  291.          If Length(Fname) = 0 then
  292.             Ch := chr(0)
  293.          Else
  294.             Begin
  295.                 j := 0;
  296.                 For i := 1 to length(Fname) do
  297.                     if fname[i] in [' ',';'] then fname[i] := ',';
  298.                 GotMem := True;
  299.                 repeat
  300.                   i := pos(',',fname);
  301.                   if I = 0 then i := Length(fname) + 1;
  302.                   temp1 := copy(fname,1,i-1);
  303.                   Delete(fname,1,i);
  304.                   Temp2 := Getpath(temp1);
  305.                   FindFirst(temp1,$27,sr);
  306.                   While (Doserror = 0) and GotMem do
  307.                      begin
  308.                       inc(j);
  309.                       Temp3 := Temp2 + Sr.name;
  310.                       GotMem := AddNametoList(Temp3);
  311.                       FindNext(sr);
  312.                      end;
  313.                 Until (Length(Fname) = 0) or (not GotMem);
  314.                 NumberofFiles := j;
  315.             end;
  316.          Case ch of
  317.             'S'        : GoodFile := SealinkTx;
  318.             'X'        : Goodfile := XmodemTx;
  319.             '1'        : Goodfile := Xmodem1KTx;
  320.             'Y'        : Goodfile := YmodemtX;
  321.             'G'        : Goodfile := YmodemGtx;
  322.             'Z'        : Goodfile := ZmodemtX;
  323. {            'P'        : Goodfile := YapptX;}
  324.          end;
  325.       end;
  326. end;
  327.  
  328. procedure Downloadfiles;
  329. var
  330.   Ch       : Char;
  331.   Fname    : String;
  332.   MoreFiles,
  333.   GoodFile : Boolean;
  334.  
  335. begin
  336.   PopupLines('Downloading - ',5,20);
  337.   Popuplines('<X> - XModem  ',0,0);
  338.   Popuplines('<1> - 1KXmodem',0,0);
  339.   Popuplines('<Y> - YModem  ',0,0);
  340.   Popuplines('<Z> - ZModem  ',0,0);
  341.   Popuplines('<P> - Yapp    ',0,0);
  342.   Ch := readKey;
  343.   ch := upcase(ch);
  344.   Remove_Window;
  345.   If (ch in ['X','1','Y','Z','P','S','G']) then
  346.       begin
  347.          If Ch in ['X','1'] then
  348.              begin
  349.                Popuplines('',2,50);
  350.                PopUpLines('Filename to receive ->___________________________',0,0);
  351.                Gotoxy(24,2);
  352.                OnCursor;
  353.                Readln(fname);
  354.                Remove_Window;
  355.                If Length(Fname) = 0 then Ch := chr(0);
  356.                Uploadpath := DownDir + Fname;
  357.              end
  358.          else
  359.            UploadPath := DownDir;
  360.          Case ch of
  361.             'X','1'    : Goodfile := XmodemRx;
  362.             'Y'        : Goodfile := YmodemRX;
  363.             'G'        : Goodfile := YmodemGRX;
  364.             'S'        : Goodfile := SealinkRX;
  365.             'Z'        : Goodfile := ZmodemRX;
  366.             'P'        : Goodfile := YappRX;
  367.          end;
  368.       end;
  369. end;
  370.  
  371. Procedure GetParms;
  372.  
  373. var
  374.    l      : longint;
  375.    I      : Byte;
  376.    j      : Integer;
  377.    temp   : String;
  378.    ch     : Char;
  379.  
  380. begin
  381.    if Paramcount > 0 then
  382.      begin
  383.        for i := 1 to paramcount do
  384.         begin
  385.            temp := Paramstr(i);
  386.            if temp[1] = '-' then Delete(temp,1,1);
  387.            Ch := upcase(Temp[1]);
  388.            Delete(temp,1,1);
  389.             Case ch of
  390.                  'B'    : Begin
  391.                             Val(temp,l,j);
  392.                             If (j = 0) then
  393.                                 repeat
  394.                                  inc(j);
  395.                                 until l <= BaudRates[j];
  396.                                 CurBaud := j;
  397.                           end;
  398.                  'D'    : begin
  399.                             DownDir := temp;
  400.                             If DownDir[Length(downdir)] <> '\' then
  401.                                DownDir := Downdir + '\';
  402.                           end;
  403.                  'P'    : Begin
  404.                             Val(temp,l,j);
  405.                             If j = 0 then CurPort := Byte(l);
  406.                           end;
  407.             end;
  408.         end;
  409.      end;
  410. end;
  411.  
  412. Procedure DosShell;
  413.  
  414. begin
  415.    Save_Screen;
  416.    writeln('Going to dos');
  417.    Exec(GetEnv('COMSPEC'),'');
  418.    Remove_Window;
  419. end;
  420.  
  421.  
  422. Procedure TermMode;
  423. Var
  424.   Lastchars   : String[6];
  425.   Ch          : Char;
  426.   GoodFile    : Boolean;
  427.  
  428. begin
  429.    Lastchars := '';
  430.    repeat
  431.    If Comm_Rx_Ready then
  432.       begin
  433.          ch := chr(comm_rx);
  434.          if Length(lastchars) = 6 then delete(lastchars,1,1);
  435.          lastchars := lastchars + ch;
  436.            Ansi_write(ch);
  437.          if Lastchars = '**'+ chr($18) + 'B00' then
  438.                begin
  439.                   ClearnameList;
  440.                   Uploadpath := Downdir;
  441.                   Goodfile := zmodemrx;
  442.                end;
  443.       end;
  444.    If Keypressed then
  445.       begin
  446.         Ch := Readkey;
  447.           if ch = #0 then
  448.               if Doorway then
  449.                 begin
  450.                    Ch := Readkey;
  451.                    If CH <> #131 then { alt-= }
  452.                       begin
  453.                         Comm_TX(0);
  454.                         Comm_Tx(Ord(ch));
  455.                       end
  456.                    else
  457.                       begin
  458.                         Doorway := false;
  459.                         Popup('Doorway mode OFF');
  460.                       end;
  461.                 end
  462.               else
  463.               begin
  464.                 Ch := Readkey;
  465.                 case ch of
  466.                    #25      : SetPort;                 {Alt_P }
  467.                    #35      : Hangup;                  {Alt_H }
  468.                    #36      : DosShell;                {Alt_J }
  469.                    #45      : Finish := true;          {Alt_X }
  470.                    #48      : SetbaudRate;             {Alt_B }
  471.                    #59      : ShowHelp;                {F1    }
  472.                    #73      : UploadFiles;             {PageUp}
  473.                    #81      : DownloadFiles;           {PageDn}
  474.                    #131     : begin                    {Alt_= }
  475.                                 Doorway := True;
  476.                                 Popup('Doorway mode ON');
  477.                               end;
  478.                 end;
  479.               end
  480.             else
  481.              Comm_Tx(ord(ch));
  482.       end;
  483.    until finish;
  484. end;
  485.  
  486. begin
  487.     writeln('Term ',version,' - Demo program for the Protocol Engine.');
  488.     Writeln('Hit F1 for help - (c) 1992 Mark Dignam - OmenTronics');
  489.     TextAttr := LightGray;
  490.     CanUseFossil := True;
  491.     Comm_Cts_Rts(True);
  492.     overwrite := false;
  493.     finish := false;
  494.     Doorway := False;
  495.     CurBaud := 5;
  496.     CurPort := 1;
  497.     Downdir := 'c:\temp\';
  498.     WindowType := 1;
  499.     GetParms;
  500.     IF comm_init(BaudRates[CurBaud],CurPort) then
  501.        begin
  502.          CurrentSettings;
  503.          TermMode;
  504.          Comm_deinit;
  505.        end
  506.      else
  507.        begin
  508.           Writeln('Sorry - but I can''t initalise port ',curport);
  509.        end;
  510. End.
  511.