home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURMEN.ZIP / TURMEN.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  39.3 KB  |  1,307 lines
  1. program Menu;
  2. {$C-,V-}
  3. type
  4.   MaxStr           =         String[255];
  5.   Str80            =         String[80];
  6.   Str2             =         String[2];
  7.  
  8. var
  9.   Ok               :         boolean;
  10.   SwitchChar       :         char;
  11.   NormalCursor     :         integer;
  12.   NoCursor         :         integer;
  13.  
  14. {*Include File     ATTKBD.CON ***** START *****}
  15.  
  16. { ***************************************************************** }
  17.                  { ATT PC Keyboard definitions }
  18. { ***************************************************************** }
  19.  
  20. const
  21.    RETURN_Key            =  #$0D;
  22.    BACKSPACE_Key         =  #$08;
  23.    ESCAPE_Key            =  #$1B;
  24.    BEEP_Key              =  #$07;
  25.    PREAMBLE_Key          =  #$00;
  26.    PREAMBLE_Byte         =  $00;
  27.    UP_Key                =  #$48;
  28.    DOWN_Key              =  #$50;
  29.    RIGHT_Key             =  #$4D;
  30.    LEFT_Key              =  #$4B;
  31.    HOME_Key              =  #$47;
  32.    INSERT_Key            =  #$52;
  33.    DELETE_Key            =  #$53;
  34.    PageDwn_Key           =  #$51;
  35.    PageUp_Key            =  #$49;
  36.    END_Key               =  #$4F;
  37.    TAB_Key               =  #$09;
  38.    BACKTAB_Key           =  #$0F;
  39.  
  40.    CTRL_LEFT_Key         =  #$73;
  41.    CTRL_RIGHT_Key        =  #$74;
  42.    CTRL_END_Key          =  #$75;
  43.    CTRL_PageDwn_Key      =  #$76;
  44.    CTRL_HOME_Key         =  #$77;
  45.    CTRL_PageUp_Key       =  #$84;
  46.  
  47.    SFKey01               =  #$3B;
  48.    SFKey02               =  #$3C;
  49.    SFKey03               =  #$3D;
  50.    SFKey04               =  #$3E;
  51.    SFKey05               =  #$3F;
  52.    SFKey06               =  #$40;
  53.    SFKey07               =  #$41;
  54.    SFKey08               =  #$42;
  55.    SFKey09               =  #$43;
  56.    SFKey10               =  #$44;
  57.  
  58.    Shift_SFKey01         =  #$54;
  59.    Shift_SFKey02         =  #$55;
  60.    Shift_SFKey03         =  #$56;
  61.    Shift_SFKey04         =  #$57;
  62.    Shift_SFKey05         =  #$58;
  63.    Shift_SFKey06         =  #$59;
  64.    Shift_SFKey07         =  #$5A;
  65.    Shift_SFKey08         =  #$5B;
  66.    Shift_SFKey09         =  #$5C;
  67.    Shift_SFKey10         =  #$5D;
  68.  
  69.    Alt_SFKey01           =  #$68;
  70.    Alt_SFKey02           =  #$69;
  71.    Alt_SFKey03           =  #$6A;
  72.    Alt_SFKey04           =  #$6B;
  73.    Alt_SFKey05           =  #$6C;
  74.    Alt_SFKey06           =  #$6D;
  75.    Alt_SFKey07           =  #$6E;
  76.    Alt_SFKey08           =  #$6F;
  77.    Alt_SFKey09           =  #$70;
  78.    Alt_SFKey10           =  #$71;
  79.  
  80. { ***************************************************************** }
  81.  
  82.  
  83. {*Include File End ATTKBD.CON ***** END *****}
  84. {*Include File     CURSOR.INC ***** START *****}
  85. { Set Cursor Size : subfunction 01h of Intr 10h.
  86.   The Documentation in the ATT Systems Programmers Guide did not
  87.   describe what the actual call does, but after experimenting the
  88.   meaning of start and end line is now clear.
  89.   The cursor size in the ATT is saved at 0040:0060; and is lines 6 - 7.
  90.  
  91. }
  92.  
  93. procedure CursorSize(NewCursor : Integer);
  94.       { This procedure call the BIOS throught interrupt 10H to set
  95.         the top and bottom line of the cursor.  Scan Lines are
  96.         hardware dependent so you will have to experiment to find
  97.         what works on your system.                                }
  98.  
  99. type
  100.   Register = record case boolean of
  101.                true : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
  102.                false: (al,ah,bl,bh,cl,ch,dl,dh : byte);
  103.              end;
  104. var
  105.   Regs                  :    Register;
  106.  
  107. begin
  108.   With Regs do
  109.     begin
  110.       ah := $01;               {ah = 1 means set cursor type}
  111.       bx := $0;                {bx = page number, zero for us}
  112.       cx := NewCursor;         {ch bits 4 to 0 = start line for cursor}
  113.                                {cl bits 4 to 0 = end line for cursor}
  114.       cl := (cl and $1F);      {mask off all but low order 5 bits}
  115.       ch := (ch and $1F);      {do the same for ch, in case of programmer}
  116.                                {error.  Can this happen? naw not a chance}
  117.       intr($10,Regs);          {set cursor}
  118.     end;
  119. end;
  120.  
  121.  
  122. {*Include File End CURSOR.INC ***** END *****}
  123. {*Include File     SCAN.INC ***** START *****}
  124. function Read_Char(var extend : boolean): char;
  125. type
  126.   Register = record case boolean of
  127.                true : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
  128.                false: (al,ah,bl,bh,cl,ch,dl,dh : byte);
  129.              end;
  130. var
  131.   Regs                  :    Register;
  132. begin
  133.   with Regs do
  134.     begin
  135.       ah := $07;
  136.       MsDos(Regs);
  137.       if al = PREAMBLE_Byte then
  138.         begin
  139.           extend := true;
  140.           MsDos(Regs);
  141.         end
  142.       else
  143.         extend := false;
  144.       Read_Char:=Chr(al);
  145.     end;
  146. end;
  147.  
  148. {*Include File End SCAN.INC ***** END *****}
  149. {*Include File     INPUTUTI.INC ***** START *****}
  150. type
  151.    AnyStr   =    String[255];
  152.    CharSet  =    Set Of Char;
  153.  
  154.  
  155. {  UpcaseStr converts a string to upper case }
  156.  
  157. function UpcaseStr(S : Str80) : Str80;
  158. var
  159.   P : Integer;
  160. begin
  161.   for P := 1 to Length(S) do
  162.     S[P] := Upcase(S[P]);
  163.   UpcaseStr := S;
  164. end;
  165.  
  166. {  ConstStr returns a string with N characters of value C }
  167.  
  168. function ConstStr(C : Char; N : Integer) : Str80;
  169. var
  170.   S : string[80];
  171. begin
  172.   if N < 0 then
  173.     N := 0;
  174.   S[0] := Chr(N);
  175.   FillChar(S[1],N,C);
  176.   ConstStr := S;
  177. end;
  178.  
  179. {  Beep sounds the terminal bell or beeper }
  180.  
  181. procedure Beep;
  182. begin
  183.   Write(BEEP_Key);
  184. end;
  185.  
  186.  
  187. procedure InputStr(var S     : AnyStr;
  188.                        L,X,Y : Integer;
  189.                        Term  : CharSet;
  190.                    var TC    : Char    );
  191. var
  192.   P                :         Integer;
  193.   Ch               :         Char;
  194.   Special          :         boolean;
  195.   InsertMode       :         boolean;
  196. begin
  197.   NormVideo;
  198.   If Length(S)>L then
  199.     S:=Copy(S,1,L);
  200.   GotoXY(X,Y); Write(S,ConstStr('_',L - Length(S)));
  201.   InsertMode:=true;
  202.   P := 0;
  203.   repeat
  204.     GotoXY(X + P,Y); Ch:=Read_Char(Special);
  205.     If Not Special then
  206.       begin
  207.         case Ch of
  208.           #32..#126 : if P < L then
  209.                       begin
  210.                         case InsertMode of
  211.                         true  :  begin
  212.                                    if Length(S) = L then
  213.                                      Delete(S,L,1);
  214.                                    P:=P+1;
  215.                                    Insert(Ch,S,P);
  216.                                    Write(Copy(S,P,L));
  217.                                    If P=L then P:=P-1;
  218.                                  end;
  219.                         false :  begin
  220.                                    P:=P+1;
  221.                                    if P <= Length(S) then
  222.                                      Delete(S,P,1);
  223.                                    Insert(Ch,S,P);
  224.                                    Write(Copy(S,P,L));
  225.                                    If P=L then P:=P-1;
  226.                                  end;
  227.                         end; { case Insert Mode }
  228.                       end;
  229.  
  230.      BACKSPACE_Key  : if P > 0 then
  231.                       begin
  232.                         Delete(S,P,1);
  233.                         Write(BACKSPACE_Key,Copy(S,P,L),'_':1);
  234.                         P := P - 1;
  235.                       end
  236.                       else Beep;
  237.         else
  238.           if not (Ch in Term) then Beep;
  239.         end;   { of case }
  240.       end
  241.     else
  242.       begin
  243.         case Ch of
  244.           LEFT_Key  : if P > 0 then
  245.                         P := P - 1
  246.                       else Beep;
  247.          RIGHT_Key  : if P < Length(S) then
  248.                         P := P + 1
  249.                       else Beep;
  250.         INSERT_Key  : InsertMode:=not InsertMode;
  251.           HOME_Key  : P := 0;
  252.            END_Key  : P := Length(S);
  253.         DELETE_Key  : if P < Length(S) then
  254.                       begin
  255.                         Delete(S,P+1,1);
  256.                         Write(Copy(S,P + 1,L),'_':1);
  257.                       end;
  258.       CTRL_END_Key  : begin
  259.                         Write(ConstStr('_',Length(S) - P));
  260.                         Delete(S,P+1,L);
  261.                       end;
  262.         else
  263.           Beep;
  264.         end;  {of case}
  265.       end;
  266.   until Ch in Term;
  267.   P := Length(S);
  268.   GotoXY(X + P ,Y);
  269.   If L>P then Write(ConstStr('_',L - P));
  270.   TC := Ch;
  271.   LowVideo;
  272. end;
  273.  
  274.  
  275. procedure Select(    Prompt : Str80;
  276.                      Term   : CharSet;
  277.                  var TC     : Char    );
  278. var
  279.   Ch               :         Char;
  280.   Special          :         boolean;
  281. begin
  282.   GotoXY(1,23); Write(Prompt,'? ' ); ClrEol;
  283.   repeat
  284.     Ch:=Read_Char(Special);
  285.     TC := Upcase(Ch);
  286.     if not (TC in Term) then
  287.       Beep;
  288.   until TC in Term;
  289.   case Ch of
  290.     #32..#126 : Write(TC);
  291.   end;
  292. end;
  293.  
  294. procedure ClearLines(F,L:integer);
  295. var
  296.   I                :         integer;
  297. begin
  298.   For I:=F to L do
  299.     begin
  300.       GotoXY(1,I);ClrEol;
  301.     end;
  302. end;
  303.  
  304.  
  305. {*Include File End INPUTUTI.INC ***** END *****}
  306. {*Include File     MESSAGE.INC ***** START *****}
  307. procedure Message(S:Str80);
  308. begin
  309.   GotoXY(1,25);ClrEol;
  310.   If Length(S)>0 then
  311.     begin
  312.       NormVideo;
  313.       Write('ERROR: ',S);
  314.       LowVideo;
  315.       Beep;
  316.     end;
  317. end;
  318. {*Include File End MESSAGE.INC ***** END *****}
  319. {*Include File     BIOSDATE.INC ***** START *****}
  320. type
  321.    Bios     =    Record
  322.                  AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:Integer;
  323.                  end;
  324.  
  325.    BiosB    =    Record
  326.                  AL,AH,BL,BH,CL,CH,DL,DH:Byte;
  327.                  end;
  328.  
  329.  
  330. procedure GetDate(var Year,Month,Day:Integer);
  331. var
  332.    Reg      :    Bios;
  333.    RegB     :    BiosB absolute Reg;
  334.  
  335. begin
  336.    RegB.AH:=$2A;
  337.    MsDos(Reg);
  338.    Year:=Reg.CX;
  339.    Month:=RegB.DH;
  340.    Day:=RegB.DL;
  341. end;
  342.  
  343. Procedure GetTime(var Hrs,Min,Sec,HSec:Integer);
  344. var
  345.    Reg      :    Bios;
  346.    RegB     :    BiosB absolute Reg;
  347.  
  348. begin
  349.    RegB.AH:=$2C;
  350.    MsDos(Reg);
  351.    Hrs:=RegB.CH;
  352.    Min:=RegB.CL;
  353.    Sec:=RegB.DH;
  354.    HSec:=RegB.DL;
  355. end;
  356.  
  357.  
  358. {*Include File End BIOSDATE.INC ***** END *****}
  359. {*Include File     GETSWITC.INC ***** START *****}
  360. { **************************************************************************
  361.   WARNING !  WARNING  ! WARNING ! WARNING ! WARNING ! WARNING ! WARNING !
  362.   -----------------------------------------------------------------------
  363.  
  364.    This function call is defined in the Program Development Guide on the
  365.    WANG system.  This function returns the switch character used by
  366.    COMMAND.COM.  On the WANG system this is '-', to try to make this
  367.    program generic I used this call.  In the IBM DOS Technical Ref 2.10
  368.    this call was documented only by the line 'USED INTERNALLY'. If this
  369.    does not work change this function to return your switch char which
  370.    is probably '/' if you are on an IBM/IBM clone.
  371.  
  372. }
  373.  
  374. function GetDOSswitch:char;
  375. type
  376.   DosRegs          =         record case integer of
  377.                                1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: integer);
  378.                                2 : (AL,AH,BL,BH,CL,CH,DL,DH: byte);
  379.                              end;
  380. var
  381.   Regs             :         DosRegs;
  382. begin
  383.   with Regs do
  384.     begin
  385.       AH:=$37;
  386.       AL:=0;
  387.     end;
  388.   MsDos(Regs);
  389.   with Regs do
  390.   GetDOSswitch:=Chr(DL);
  391. end;
  392.  
  393.  
  394. {*Include File End GETSWITC.INC ***** END *****}
  395. {*Include File     FILLZERO.INC ***** START *****}
  396. procedure FillZero(var S:MaxStr);
  397. var
  398.   I                :         integer;
  399. begin
  400.   for I:=1 to Length(S) do
  401.     If S[I]=' ' then
  402.       S[I]:='0';
  403. end;
  404.  
  405. {*Include File End FILLZERO.INC ***** END *****}
  406. {*Include File     SPFUN.INC ***** START *****}
  407. { these routines use the MSDOS functions to get the date and time.  The
  408.   data is then converted into printable format. }
  409.  
  410. function CurrentDate:Str80;
  411. var
  412.   Month,
  413.   Day,
  414.   Year   :   Integer;
  415.   S,T    :   MaxStr;
  416.  
  417. begin
  418.    GetDate(Year,Month,Day);
  419.    Str(Month:2,S);
  420.    FillZero(S);
  421.    T:=S+'/';
  422.    Str(Day:2,S);
  423.    FillZero(S);
  424.    T:=T+S+'/';
  425.    Str(Year,S);
  426.    T:=T+S;
  427.    CurrentDate:=T;
  428. end;
  429.  
  430. function Time:Str80;
  431. var
  432.   Hrs,
  433.   Min,
  434.   Sec,
  435.   HSec : Integer;
  436.   S,T  : MaxStr;
  437.  
  438. begin
  439.    GetTime(Hrs,Min,Sec,HSec);
  440.    If Hrs>12 then Str(Hrs-12:2,S)
  441.    Else           Str(Hrs:2,S);
  442.    FillZero(S);
  443.    T:=S+':';
  444.    Str(Min:2,S);
  445.    FillZero(S);
  446.    T:=T+S+':';
  447.    Str(Sec:2,S);
  448.    FillZero(S);
  449.    T:=T+S;
  450.    If (Hrs=12) and (Min=0) then T:=T+'  M' Else
  451.    If Hrs<12 then T:=T+' AM' Else
  452.    T:=T+' PM';
  453.    Time:=T;
  454. end;
  455.  
  456. {*Include File End SPFUN.INC ***** END *****}
  457. {*Include File     EXEC.INC ***** START *****}
  458. { EXEC.PAS version 1.3
  459.  
  460.   This file contains 2 functions for Turbo Pascal that allow you to run other
  461.   programs from within a Turbo program.  The first function, SubProcess,
  462.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  463.   second function, GetComSpec, returns the path name of the command
  464.   interpreter, which is necessary to do certain operations.  There is also a
  465.   main program that allows you to test the functions.
  466.  
  467.   Revision history
  468.   ----------------
  469.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  470.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  471.               addressed relative to BP, using a destroyed BP!
  472.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  473.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  474.  
  475.     -  Bela Lubkin
  476.        Borland International Technical Support
  477.        CompuServe 71016,1573
  478. }
  479.  
  480. Type
  481.   Str66=String[66];
  482.   Str255=String[255];
  483.  
  484. Function SubProcess(CommandLine: Str255): Integer;
  485.   { Pass this function a string of the form
  486.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  487.  
  488.     For example,
  489.       'C:\SYSTEM\CHKDSK.COM'
  490.       'A:\WS.COM DOCUMENT.1'
  491.       'C:\DOS\LINK.EXE TEST;'
  492.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  493.  
  494.     The third example shows several things.  To do any of the following, you
  495.     must invoke the command processor and let it do the work: redirection;
  496.     piping; path searching; searching for the extension of a program (.COM,
  497.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  498.     command processor file is stored in the DOS environment.  The function
  499.     GetComSpec in this file returns the path name of the command processor.
  500.     Also note that you must use the /C parameter or COMMAND will not work
  501.     correctly.  You can also call COMMAND with no parameters.  This will allow
  502.     the user to use the DOS prompt to run anything (as long as there is enough
  503.     memory).  To get back to your program, he can type the command EXIT.
  504.  
  505.     Actual example:
  506.       I:=SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  507.  
  508.     The value returned is the result returned by DOS after the EXEC call.  The
  509.     most common values are:
  510.  
  511.        0: Success
  512.        1: Invalid function (should never happen with this routine)
  513.        2: File/path not found
  514.        8: Not enough memory to load program
  515.       10: Bad environment (greater than 32K)
  516.       11: Illegal .EXE file format
  517.  
  518.     If you get any other result, consult an MS-DOS Technical Reference manual.
  519.  
  520.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  521.     restrict the amount of free dynamic memory used by your program.  Only the
  522.     memory that is not used by the heap is available for use by other
  523.     programs. }
  524.  
  525.   Const
  526.     SSSave: Integer=0;
  527.     SPSave: Integer=0;
  528.  
  529.   Var
  530.     Regs: Record Case Integer Of
  531.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  532.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  533.           End;
  534.     FCB1,FCB2: Array [0..36] Of Byte;
  535.     PathName: Str66;
  536.     CommandTail: Str255;
  537.     ParmTable: Record
  538.                  EnvSeg: Integer;
  539.                  ComLin: ^Integer;
  540.                  FCB1Pr: ^Integer;
  541.                  FCB2Pr: ^Integer;
  542.                End;
  543.     I,RegsFlags: Integer;
  544.  
  545.   Begin
  546.     If Pos(' ',CommandLine)=0 Then
  547.      Begin
  548.       PathName:=CommandLine+#0;
  549.       CommandTail:=^M;
  550.      End
  551.     Else
  552.      Begin
  553.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  554.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  555.      End;
  556.     CommandTail[0]:=Pred(CommandTail[0]);
  557.     With Regs Do
  558.      Begin
  559.       FillChar(FCB1,Sizeof(FCB1),0);
  560.       AX:=$2901;
  561.       DS:=Seg(CommandTail[1]);
  562.       SI:=Ofs(CommandTail[1]);
  563.       ES:=Seg(FCB1);
  564.       DI:=Ofs(FCB1);
  565.       MsDos(Regs); { Create FCB 1 }
  566.       FillChar(FCB2,Sizeof(FCB2),0);
  567.       AX:=$2901;
  568.       ES:=Seg(FCB2);
  569.       DI:=Ofs(FCB2);
  570.       MsDos(Regs); { Create FCB 2 }
  571. (*    ES:=CSeg;
  572.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  573.       AH:=$4A;
  574.       MsDos(Regs); { Deallocate unused memory }  *)
  575.       With ParmTable Do
  576.        Begin
  577.         EnvSeg:=MemW[CSeg:$002C];
  578.         ComLin:=Addr(CommandTail);
  579.         FCB1Pr:=Addr(FCB1);
  580.         FCB2Pr:=Addr(FCB2);
  581.        End;
  582.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  583.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  584.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  585.              $1E/$55/                 { Save <DS>, <BP>         }
  586.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  587.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  588.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  589.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  590.              $FA/                     { Disable interrupts      }
  591.              $CD/$21/                 { Call MS-DOS             }
  592.              $FA/                     { Disable interrupts      }
  593.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  594.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  595.              $FB/                     { Enable interrupts       }
  596.              $5D/$1F/                 { Restore <BP>,<DS>       }
  597.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  598.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  599.       { The messing around with SS and SP is necessary because under DOS 2.x,
  600.         after returning from an EXEC call, ALL registers are destroyed except
  601.         CS and IP!  I wish I'd known that before I released this package the
  602.         first time... }
  603.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  604.       Else SubProcess:=0;
  605.      End;
  606.   End;
  607.  
  608. Function GetComSpec: Str66;
  609.   Type
  610.     Env=Array [0..32767] Of Char;
  611.   Var
  612.     EPtr: ^Env;
  613.     EStr: Str255;
  614.     Done: Boolean;
  615.     I: Integer;
  616.  
  617.   Begin
  618.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  619.     I:=0;
  620.     Done:=False;
  621.     EStr:='';
  622.     Repeat
  623.       If EPtr^[I]=#0 Then
  624.        Begin
  625.         If EPtr^[I+1]=#0 Then Done:=True;
  626.         If Copy(EStr,1,8)='COMSPEC=' Then
  627.          Begin
  628.           GetComSpec:=Copy(EStr,9,100);
  629.           Done:=True;
  630.          End;
  631.         EStr:='';
  632.        End
  633.       Else EStr:=EStr+EPtr^[I];
  634.       I:=I+1;
  635.     Until Done;
  636.   End;
  637.  
  638.  
  639. {*Include File End EXEC.INC ***** END *****}
  640. {*Include File     CURDRIVE.INC ***** START *****}
  641. procedure CurrentDrive(var S:Str2);
  642. type
  643.   DosRegs          =         record case integer of
  644.                                1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: integer);
  645.                                2 : (AL,AH,BL,BH,CL,CH,DL,DH: byte);
  646.                              end;
  647. var
  648.   Regs             :         DosRegs;
  649. begin
  650.   Regs.AH:=$19;         { Current Disk function code }
  651.   MsDos(Regs);          { do it , close your eyes    }
  652.   S:=Chr(Ord('A')+Regs.AL)+':';
  653.                         { Generate drive designation }
  654. end;
  655.  
  656.  
  657. {*Include File End CURDRIVE.INC ***** END *****}
  658. {*Include File     MENUTYPE.INC ***** START *****}
  659. type
  660.   bytechar         =         record case boolean of
  661.                              true : (c:char);
  662.                              false: (b:byte);
  663.                              end;
  664.   MenuPointer      =         ^MenuBuffer;
  665.   MenuBuffer       =         record
  666.                                Buf            :         Array [1..5,0..255] of bytechar;
  667.                              end;
  668.   HelpPointer      =         ^HelpBuffer;
  669.   HelpBuffer       =         record
  670.                                Buf            :         Array [1..187,0..255] of bytechar;
  671.                              end;
  672.  
  673.   ByteFile         =         file;
  674.  
  675. const
  676.   Special          :         set of char = [#$09,#$08,#$0D,#$20,ESCAPE_Key];
  677.  
  678. var
  679.   HBuffer          :         HelpBuffer;
  680.   MBuffer          :         MenuBuffer;
  681.   FilVar           :         ByteFile;
  682.  
  683. {*Include File End MENUTYPE.INC ***** END *****}
  684. {*Include File     HANDLE.INC ***** START *****}
  685. {  The Following functions were written to take care of the ReadBlock
  686.    bug in Turbo V3.0.  The FileHandle function returns the MSDOS file
  687.    handle to be used in reading from a file.  The DosBlockRead function
  688.    will attempt to read Recs number of bytes from a file with handle
  689.    FileH.  If no error occurs then the number of bytes read will be
  690.    return in Result, otherwise Result will be -1.
  691.  
  692.   Gary W. Miller
  693.   70127,3674    Compuserve
  694.  
  695. }
  696.  
  697. function FileHandle(var FilVar):integer;
  698. var
  699.   H                :         integer absolute FilVar;
  700. begin
  701.   FileHandle:=H;
  702. end;
  703.  
  704.  
  705. procedure DosBlockRead(FileH:integer;var Buffer;Recs:integer;var Result:integer);
  706. type
  707.   DosRegs          =         record case integer of
  708.                                1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: integer);
  709.                                2 : (AL,AH,BL,BH,CL,CH,DL,DH: byte);
  710.                              end;
  711. var
  712.   Regs             :         DosRegs;
  713. begin
  714.   with Regs do
  715.     begin
  716.       DS:=Seg(Buffer);  { location of Buffer segment }
  717.       DX:=Ofs(Buffer);  {                    offset  }
  718.       CX:=Recs;         { number of bytes to read    }
  719.       AH:=$3f;          { Read File or Device Code   }
  720.       BX:=FileH;        { Pass file handle           }
  721.     end;
  722.   MsDos(Regs);          { do it , close your eyes    }
  723.   with Regs do
  724.     begin
  725.       If (Flags and 1)<>0 then
  726.         Result:=-1      { crap, we blew it           }
  727.       else
  728.         Result:=AX;     { tell me what you read      }
  729.     end;
  730. end;
  731.  
  732.  
  733. procedure DosBlockWrite(FileH:integer;var Buffer;Recs:integer;var Result:integer);
  734. type
  735.   DosRegs          =         record case integer of
  736.                                1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: integer);
  737.                                2 : (AL,AH,BL,BH,CL,CH,DL,DH: byte);
  738.                              end;
  739. var
  740.   Regs             :         DosRegs;
  741. begin
  742.   with Regs do
  743.     begin
  744.       DS:=Seg(Buffer);  { location of Buffer segment }
  745.       DX:=Ofs(Buffer);  {                    offset  }
  746.       CX:=Recs;         { number of bytes to write   }
  747.       AH:=$40;          { Write File or Device Code  }
  748.       BX:=FileH;        { Pass file handle           }
  749.     end;
  750.   MsDos(Regs);          { do it , close your eyes    }
  751.   with Regs do
  752.     begin
  753.       If (Flags and 1)<>0 then
  754.         Result:=-1      { crap, we blew it           }
  755.       else
  756.         Result:=AX;     { tell me what you wrote     }
  757.     end;
  758. end;
  759.  
  760.  
  761. {*Include File End HANDLE.INC ***** END *****}
  762. {*Include File     CHGDIR.INC ***** START *****}
  763. { This procedure changes the current logged directory or drive based
  764.   on the string passed.  To change the logged drive pass this function
  765.   the drive you wish to change to.  To change directory pass the complete
  766.   path name of the directory to change to.  If any error occurs while
  767.   making the change an error flag will be returned. }
  768.  
  769. procedure ChangeDir(S:AnyStr;var Ok:boolean);
  770. begin
  771.   {$I-}
  772.     ChDir(S);
  773.   {$I+}
  774.   Ok:=(IOresult=0);
  775. end;
  776.  
  777. { This procedure makes the rather rash assumtion that what ever path you
  778.   pass it exists.  If it does not exist then the function will return
  779.   without doing anything. }
  780.  
  781. procedure ReturnToPath(S:AnyStr);
  782. var
  783.   Ok               :         boolean;
  784.  
  785. begin
  786.   ChangeDir(S,Ok);
  787. end;
  788.  
  789. {*Include File End CHGDIR.INC ***** END *****}
  790.  
  791. {*Include File     MENUPROC.INC ***** START *****}
  792. procedure Display(var Buffer);
  793. type
  794.   LineRec          =         record
  795.                                y            :         byte;
  796.                                x            :         byte;
  797.                                txt          :         String[255];
  798.                              end;
  799.  
  800. var
  801.   MenuLine         :         LineRec absolute Buffer;
  802.   i                :         integer;
  803.   flag             :         boolean;
  804. begin
  805.   with MenuLine do
  806.     begin
  807.       if x = $ff then
  808.         begin
  809.           i:=1;
  810.           while txt[i]<>#03 do
  811.             i:=i+1;
  812.           x:=40-((i) shr 1);
  813.         end;
  814.       GotoXY(x,y+1);
  815.       If txt[0]=Chr(2) then
  816.         begin
  817.           i:=1;
  818.           flag:=true;
  819.           while txt[i]<>#03 do
  820.             begin
  821.               if flag and (txt[i]>#$20) then
  822.                 flag:=false;
  823.               i:=i+1;
  824.             end;
  825.           If not flag then
  826.             txt[0]:=Chr(i-1)
  827.           else
  828.             txt[0]:=Chr(0);
  829.         end;
  830.       If length(txt)>0 then
  831.         write(txt);
  832.     end;
  833. end;
  834.  
  835. procedure Entry(i:integer;var b,o:byte;var buffer);
  836. type
  837.   OffRec           =         record
  838.                                offset       :         byte;
  839.                                blk          :         byte;
  840.                              end;
  841.   OffTable         =         Array [0..52] of OffRec;
  842. var
  843.   table            :         Offtable absolute buffer;
  844. begin
  845.   with table[i] do
  846.     begin
  847.       b:=blk;
  848.       o:=offset;
  849.     end;
  850. end;
  851.  
  852. procedure RunInfo(var Buffer                 ;
  853.                   var Fname  :          Str80;
  854.                   var Path   :          Str80;
  855.                   var Drive  :          Str80;
  856.                   var ParmStr:          Str80;
  857.                   var flag   :          byte;
  858.                   var help   :          byte);
  859. type
  860.   RunRec           =         record
  861.                                pflag        :         byte;
  862.                                phelp        :         byte;
  863.                                junk         :         byte;
  864.                                pdisk        :         byte;
  865.                                ptxt         :         Array [1..255] of char;
  866.                              end;
  867. var
  868.   prec             :         RunRec absolute Buffer;
  869.   f,t              :         integer;
  870.   k,p              :         integer;
  871.   i                :         integer;
  872. begin
  873.   with prec do
  874.     begin
  875.       flag:=pflag;
  876.       help:=phelp;
  877.       if pdisk=0 then
  878.         Fname:=''
  879.       else
  880.         Fname:=Chr($40+pdisk)+':';
  881.       Drive:=Fname;
  882.       Path:='';
  883.       f:=Length(Path);
  884.       k:=1;
  885.       if (ptxt[k]='/') or (ptxt[k]='\') then
  886.         begin
  887.           repeat
  888.             f:=f+1;
  889.             Path[f]:=ptxt[k];
  890.             k:=k+1;
  891.           Until ptxt[k]=#$20;
  892.           k:=k+1;
  893.           Path[0]:=Chr(f-1);
  894.         end;
  895.       f:=length(fname);
  896.       p:=k+7;
  897.       t:=0;
  898.       for i:=k to k+10 do
  899.         begin
  900.           if ptxt[i]<>#$20 then
  901.             begin
  902.               if (i>=p) and (t=0) then
  903.                 begin
  904.                   t:=1;
  905.                   f:=f+1;
  906.                   fname[f]:='.';
  907.                 end;
  908.               f:=f+1;
  909.               fname[f]:=ptxt[i];
  910.             end;
  911.         end;
  912.       fname[0]:=chr(f);
  913.       ParmStr:='';
  914.       k:=0;
  915.       i:=i+1;
  916.       while ptxt[i] <> #$03 do
  917.         begin
  918.           k:=k+1;
  919.           ParmStr[k]:=ptxt[i];
  920.           i:=i+1;
  921.         end;
  922.       ParmStr[0]:=chr(k);
  923.     end;
  924. end;
  925.  
  926.  
  927. {*Include File End MENUPROC.INC ***** END *****}
  928. {*Include File     DISPHELP.INC ***** START *****}
  929. procedure DisplayHelp(i:byte;var HBuffer:HelpBuffer);
  930. var
  931.   k,l              :         integer;
  932.   b,o              :         byte;
  933.   t                :         char;
  934. begin
  935.   ClrScr;
  936.   LowVideo;
  937.   l:=1+(i-1)*22;
  938.   for k:=l to l+21 do
  939.     begin
  940.       Entry(k,b,o,HBuffer);
  941.       Display(HBuffer.Buf[b,o]);
  942.     end;
  943.   NormVideo;
  944.   GotoXY(1,24);write('Press Any Key to Return');
  945.   LowVideo;
  946.   Read(Kbd,t);
  947.   ClrScr;
  948. end;
  949. {*Include File End DISPHELP.INC ***** END *****}
  950. {*Include File     DISPMENU.INC ***** START *****}
  951. procedure DisplayMenu(UserSel:integer;var MBuffer:MenuBuffer);
  952. var
  953.   k                :         integer;
  954.   l                :         integer;
  955.   b,o              :         byte;
  956. begin
  957.   ClrScr;
  958.   NormVideo;
  959.   GotoXY(5,5);Write('Select and then Proceed:');
  960.   LowVideo;
  961.   For k:=1 to 3 do
  962.     begin
  963.       Entry(k,b,o,MBuffer);
  964.       Display(MBuffer.Buf[b,o]);
  965.     end;
  966.   Entry(0,b,o,MBuffer);
  967.   l:=MBuffer.Buf[b,o+1].b-1;
  968.   For k:=0 to l do
  969.     begin
  970.       If k = UserSel then
  971.         NormVideo
  972.       else
  973.         LowVideo;
  974.       Entry(k+4,b,o,MBuffer);
  975.       Display(MBuffer.Buf[b,o]);
  976.       LowVideo;
  977.     end;
  978.     GotoXY(50,21);write('RETURN   -   Proceed');
  979.     GotoXY(50,22);write('TAB      -   Help');
  980.     GotoXY(50,23);write('SPACE    -   Select');
  981.     GotoXY(50,24);write('ESCAPE   -   Previous Menu');
  982. end;
  983.  
  984. procedure HighLight(var Old:byte;New:byte;MBuffer:MenuBuffer);
  985. var
  986.   b,o              :         byte;
  987. begin
  988.   LowVideo;
  989.   Entry(Old+4,b,o,MBuffer);
  990.   Display(MBuffer.Buf[b,o]);
  991.   NormVideo;
  992.   Old:=New;
  993.   Entry(Old+4,b,o,MBuffer);
  994.   Display(MBuffer.Buf[b,o]);
  995.   LowVideo;
  996. end;
  997.  
  998. procedure ReadMenu(var Fname:Str80;var Good:boolean);
  999. var
  1000.   k                :         integer;
  1001.   FilVar           :         ByteFile;
  1002.   Result           :         integer;
  1003. begin
  1004.   Assign(FilVar,Fname);
  1005.   {$I-} Reset(FilVar); {$I+}
  1006.   Good:=(IOresult=0);
  1007.   If Good then
  1008.     begin
  1009.       k:=1;
  1010.       repeat
  1011.         with MBuffer do
  1012.           DosBlockRead(FileHandle(FilVar),Buf[k],4096,Result);
  1013.         k:=k+16;
  1014.       Until Result=0;
  1015.       Close(FilVar);
  1016.     end;
  1017. end;
  1018.  
  1019. procedure ReadHelp(var Fname:Str80;var Good:boolean);
  1020. var
  1021.   k                :         integer;
  1022.   FilVar           :         ByteFile;
  1023.   Result           :         integer;
  1024. begin
  1025.   Assign(FilVar,Fname);
  1026.   {$I-} Reset(FilVar); {$I+}
  1027.   Good:=(IOresult=0);
  1028.   If Good then
  1029.     begin
  1030.       k:=1;
  1031.       repeat
  1032.         with HBuffer do
  1033.           DosBlockRead(FileHandle(FilVar),Buf[k],4096,Result);
  1034.         k:=k+16;
  1035.       Until Result=0;
  1036.       Close(FilVar);
  1037.     end;
  1038. end;
  1039.  
  1040. procedure Menu(Fname,Path,Drive:Str80;var Ok:boolean);
  1041. var
  1042.   OkDir,
  1043.   HelpCheck,
  1044.   MenuOk,
  1045.   HelpAvailable    :         boolean;
  1046.   UserSel          :         byte;
  1047.   t,TC             :         char;
  1048.   CDrive           :         Str2;
  1049.   CurrentDir       :         String[80];
  1050.   l                :         byte;
  1051.   FirstLetter      :         String[24];
  1052.   b,o              :         byte;
  1053.   k                :         byte;
  1054.   HFname,
  1055.   Rname,
  1056.   Rpath,
  1057.   Rdrive,
  1058.   Rparm            :         Str80;
  1059.   Rflag,
  1060.   Rhelp            :         byte;
  1061.   R                :         integer;
  1062. begin
  1063.   Ok:=true;
  1064.   GetDir(0,CurrentDir);
  1065.   CurrentDrive(CDrive);
  1066.   If Length(Drive) > 0 then
  1067.     ChangeDir(Drive,Ok)
  1068.   else
  1069.     Drive:=CDrive;
  1070.   If (Length(Path)>0) and Ok then
  1071.     ChangeDir(Path,Ok)
  1072.   else
  1073.     Path:=CurrentDir;
  1074.   If Ok then ReadMenu(Fname,Ok);
  1075.   HFname:=Copy(Fname,1,Pos('.',Fname))+'hlp';
  1076.   HelpCheck:=false;
  1077.   If Ok then
  1078.     begin
  1079.       Entry(0,b,o,MBuffer);
  1080.       l:=MBuffer.Buf[b,o+1].b;
  1081.       for k:=4 to l+3 do
  1082.         begin
  1083.           Entry(k,b,o,MBuffer);
  1084.           FirstLetter[k-3]:=MBuffer.Buf[b,o+3].c;
  1085.         end;
  1086.       FirstLetter[0]:=chr(l);
  1087.       UserSel:=0;
  1088.       DisplayMenu(UserSel,MBuffer);
  1089.       t:=#0;
  1090.       repeat
  1091.         If KeyPressed then
  1092.         begin
  1093.         Read(Kbd,t);
  1094.         t:=UpCase(t);
  1095.         Message('');
  1096.         If (t in Special) then
  1097.           case t of
  1098.       RETURN_Key :begin
  1099.                     Entry(UserSel+4+l,b,o,MBuffer);
  1100.                     RunInfo(MBuffer.Buf[b,o],Rname,Rpath,Rdrive,Rparm,Rflag,Rhelp);
  1101.                     if Rflag=0 then
  1102.                       begin
  1103.                         Menu(Rname,Rpath,Rdrive,MenuOk);
  1104.                         If MenuOk then
  1105.                           begin
  1106.                             ReadHelp(HFname,HelpAvailable);
  1107.                             ReadMenu(Fname,Ok);
  1108.                             DisplayMenu(UserSel,MBuffer);
  1109.                           end
  1110.                         else
  1111.                           Message('Unable to access Menu '+Rname);
  1112.                       end
  1113.                     else
  1114.                     If (Rflag=1) or (Rflag=3) then
  1115.                       begin
  1116.                         OkDir:=true;
  1117.                         If Length(Rdrive)>0 then
  1118.                           ChangeDir(Rdrive,OkDir);
  1119.                         If (Length(Rpath)>0) and OkDir then
  1120.                           ChangeDir(Rpath,OkDir);
  1121.                         ClrScr;
  1122.                         CursorSize(NormalCursor);
  1123.                         If OkDir then
  1124.                           R:=Subprocess(Rname+' '+Rparm)
  1125.                         else
  1126.                           R:=1;
  1127.                         CursorSize(NoCursor);
  1128.                         If (R=0) and (Rflag=3) then
  1129.                           begin
  1130.                             NormVideo;GotoXY(1,25);ClrEol;
  1131.                             write('Press any Key to Return to Menu');
  1132.                             Read(Kbd,t);
  1133.                             LowVideo;
  1134.                           end;
  1135.                         ReturnToPath(Drive+Path);
  1136.                         DisplayMenu(UserSel,MBuffer);
  1137.                         If R<>0 then
  1138.                           begin
  1139.                             If OkDir then
  1140.                               Message('Unable to run '+Rname)
  1141.                             else
  1142.                               Message('Unable to find '+Rdrive+Rpath);
  1143.                           end;
  1144.                       end
  1145.                     else
  1146.                     If Rflag=2 then
  1147.                       begin
  1148.                         GotoXY(5,5);ClrEol;LowVideo;
  1149.                         write('File Spec: ');
  1150.                         NormVideo;
  1151.                         CursorSize(NormalCursor);
  1152.                         Rname:='';
  1153.                         InputStr(Rname,60,17,5,[RETURN_Key,ESCAPE_Key],TC);
  1154.                         LowVideo;
  1155.                         If (Length(Rname) > 0) and (TC = RETURN_Key) then
  1156.                           begin
  1157.                             ClrScr;
  1158.                             R:=Subprocess(GetComSpec+' '+SwitchChar+'C '+Rname);
  1159.                             CursorSize(NoCursor);
  1160.                             If (R=0) then
  1161.                               begin
  1162.                                 NormVideo;GotoXY(1,25);ClrEol;
  1163.                                 write('Press any Key to Return to Menu');
  1164.                                 Read(Kbd,t);
  1165.                                 LowVideo;
  1166.                               end;
  1167.                             ReturnToPath(Drive+Path);
  1168.                             DisplayMenu(UserSel,MBuffer);
  1169.                             If R<>0 then
  1170.                               Message('Unable to run '+Rname);
  1171.                           end
  1172.                         else
  1173.                           begin
  1174.                             CursorSize(NoCursor);
  1175.                             DisplayMenu(UserSel,MBuffer)
  1176.                           end;
  1177.                       end
  1178.                     else
  1179.                     If Rflag=4 then
  1180.                       begin
  1181.                         CursorSize(NormalCursor);
  1182.                         ClrScr;
  1183.                         NormVideo;
  1184.                         writeln('Type EXIT to return to the Menu');
  1185.                         LowVideo;
  1186.                         R:=Subprocess(GetComSpec);
  1187.                         ReturnToPath(Drive+Path);
  1188.                         CursorSize(NoCursor);
  1189.                         If R=0 then
  1190.                           DisplayMenu(UserSel,MBuffer)
  1191.                         else
  1192.                           Message('Unable to run '+Rname);
  1193.                       end
  1194.                     else
  1195.                     If Rflag=5 then
  1196.                       begin
  1197.                         OkDir:=true;
  1198.                         If Length(Rdrive)>0 then
  1199.                           ChangeDir(Rdrive,OkDir);
  1200.                         If (Length(Rpath)>0) and OkDir then
  1201.                           ChangeDir(Rpath,OkDir);
  1202.                         CursorSize(NormalCursor);
  1203.                         LowVideo;
  1204.                         ClrScr;
  1205.                         if OkDir then
  1206.                           R:=Subprocess(GetComSpec+' '+SwitchChar+'C '+Rname)
  1207.                         else
  1208.                           R:=1;
  1209.                         CursorSize(NoCursor);
  1210.                         ReturnToPath(Drive+Path);
  1211.                         If (R=0) then
  1212.                           begin
  1213.                             NormVideo;GotoXY(1,25);ClrEol;
  1214.                             write('Press any Key to Return to Menu');
  1215.                             Read(Kbd,t);
  1216.                             LowVideo;
  1217.                           end;
  1218.                         DisplayMenu(UserSel,MBuffer);
  1219.                         If R<>0 then
  1220.                           begin
  1221.                             If OkDir then
  1222.                               Message('Unable to run '+Rname)
  1223.                             else
  1224.                               Message('Unable to find '+Rdrive+Rpath);
  1225.                           end;
  1226.                       end
  1227.                     else
  1228.                       Beep;
  1229.                   end;
  1230.  
  1231.      TAB_Key     :begin
  1232.                     Entry(UserSel+4+l,b,o,MBuffer);
  1233.                     RunInfo(MBuffer.Buf[b,o],Rname,Rpath,Rdrive,Rparm,Rflag,Rhelp);
  1234.                     If Rhelp=0 then
  1235.                       begin
  1236.                         Beep;
  1237.                         Message('Help not available');
  1238.                       end
  1239.                     else
  1240.                       begin
  1241.                         If not HelpCheck then
  1242.                           ReadHelp(HFname,HelpAvailable);
  1243.                         HelpCheck:=true;
  1244.                         If HelpAvailable then
  1245.                           begin
  1246.                             DisplayHelp(Rhelp,HBuffer);
  1247.                             DisplayMenu(UserSel,MBuffer);
  1248.                           end
  1249.                         else
  1250.                           begin
  1251.                             Beep;
  1252.                             Message('Help not available');
  1253.                           end;
  1254.                       end;
  1255.                   end;
  1256.  
  1257.            #$20  :begin
  1258.                     k:=(UserSel+1) mod l;
  1259.                     HighLight(UserSel,k,MBuffer);
  1260.                   end;
  1261.  
  1262.     BACKSPACE_Key :begin
  1263.                     if k>0 then
  1264.                       k:=UserSel-1
  1265.                     else
  1266.                       k:=l-1;
  1267.                     HighLight(UserSel,k,MBuffer);
  1268.                   end;
  1269.           end
  1270.         else
  1271.           If Pos(t,FirstLetter)<>0 then
  1272.             begin
  1273.               k:=Pos(t,Copy(FirstLetter,UserSel+2,l));
  1274.               If k=0 then
  1275.                 k:=Pos(t,Copy(FirstLetter,1,UserSel))
  1276.               else
  1277.                 k:=k+UserSel+1;
  1278.               if k=0 then
  1279.                 Beep
  1280.               else
  1281.                 HighLight(UserSel,k-1,MBuffer);
  1282.             end
  1283.         else
  1284.           Beep;
  1285.         end;
  1286.         GotoXY(1,1);write(Time);
  1287.         GotoXY(71,1);write(CurrentDate);
  1288.       Until t=ESCAPE_Key;
  1289.     end;
  1290.   ReturnToPath(CDrive+CurrentDir);
  1291. end;
  1292.  
  1293.  
  1294.  
  1295. {*Include File End DISPMENU.INC ***** END *****}
  1296.  
  1297. begin
  1298.   NoCursor:=$1f1f;
  1299.   NormalCursor:=MemW[$0040:$0060];
  1300.   SwitchChar:=GetDOSswitch;
  1301.   CursorSize(NoCursor);
  1302.   repeat
  1303.     Menu('menu.dat','','',Ok);
  1304.   Until not Ok;
  1305.   CursorSize(NormalCursor);
  1306. end.
  1307.