home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / cmplangm / 1989_4 / env / key.pas < prev    next >
Pascal/Delphi Source File  |  1989-02-01  |  2KB  |  103 lines
  1. {bt
  2. (* Turbo Pascal version 4 *)
  3. {$B-,D-,F-,I-,L+,N-,R-,S-,T-,V-}
  4. {$M 4096,0,0}
  5.  
  6. PROGRAM Key;
  7.  
  8.  { batch file enhancer }
  9.  
  10. USES Dos, Crt, Env;
  11.  
  12. VAR
  13.   EnvVar   : string;
  14.   EnvError : integer;
  15.   Regs     : Registers;
  16.  
  17. PROCEDURE CursorOff;
  18.  
  19. begin
  20.   with Regs do
  21.     AX := $0300;
  22.   Intr($10,Regs);
  23.   with Regs do
  24.     begin
  25.       CX := CX or $2000;
  26.       AX := $0100;
  27.     end;
  28.   Intr($10,Regs);
  29. end;  { CursorOff }
  30.  
  31. PROCEDURE CursorOn;
  32.  
  33. begin
  34.   with Regs do
  35.     AX := $0300;
  36.   Intr($10,Regs);
  37.   with Regs do
  38.     begin
  39.       CX := CX and $DFFF;
  40.       AX := $0100;
  41.     end;
  42.   Intr($10,Regs);
  43. end;  { CursorOn }
  44.  
  45. FUNCTION UpStr(St : string) : string;
  46.  
  47. VAR
  48.   i : byte;
  49.  
  50. begin
  51.   for i := 1 to Length(St) do
  52.     St[i] := UpCase(St[i]);
  53.   UpStr := St;
  54. end;  { UpStr }
  55.  
  56. FUNCTION UserSelect : char;
  57.  
  58. VAR
  59.   c : integer;
  60.   p : integer;
  61.   i : integer;
  62.   ch : char;       { user selection }
  63.   Param : string;  { user options }
  64.  
  65. begin
  66.   c := ParamCount;
  67.   if c = 0 then
  68.     begin
  69.       Writeln('Invalid parameter');
  70.       Halt;
  71.     end
  72.   else
  73.     begin
  74.       Param := '';
  75.  
  76.       { get user menu options }
  77.       for i := 1 to c do
  78.         Param := UpStr(ParamStr(i));
  79.  
  80.       { get user selection }
  81.       repeat
  82.         ch := UpCase(ReadKey);
  83.         p := Pos(ch,Param);
  84.       until (p <> 0) or (ch = #3) or (ch = #27);
  85.       if (ch = #3) or (ch = #27) then
  86.         ch := '0';
  87.       UserSelect := ch;
  88.     end;  { else }
  89. end;  { UserSelect }
  90.  
  91. begin  { Key }
  92.   CursorOff;
  93.   UseCurrentEnv := true;
  94.   EnvVar := UserSelect;
  95.   WriteEnvVar('KEY',EnvVar,EnvError);
  96.   CursorOn;
  97.   case EnvError of
  98.     1 : Halt(1);
  99.     2 : Halt(2);
  100.   end;  { case }
  101. end.  { Key }
  102. {et
  103.