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