home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol11n01.zip / INKEY.ZIP / INKEY.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-10  |  9KB  |  265 lines
  1. {$D-,L-,R-,S-}
  2. PROGRAM inkey;
  3. USES CRT, DOS;
  4.  
  5. TYPE
  6.   string2   = String[2];
  7.   errortype = (none, envNotFound, invalidEnv, envTooSmall);
  8.  
  9. VAR
  10.   envInUse   : Word;       {bytes in environment up to 1st double 0 }
  11.   envPos     : Word;       {location of KEY in environment          }
  12.   envSeg     : Word;       {address of environment                  }
  13.   envSize    : Word;       {maximum size of environment             }
  14.   error      : errortype;  {errors finding environment              }
  15.   newKey     : String;     {new value for KEY                       }
  16.   oldKey     : String;     {KEY when initially run if any           }
  17.   paramFound : Boolean;    {if the parameter /u is in command line  }
  18.  
  19. CONST
  20.   topRow  : String[10] = 'QWERTYUIOP';
  21.   midRow  : String[09] = 'ASDFGHJKL';
  22.   botRow  : String[07] = 'ZXCVBNM';
  23.   numbers : String[10] = '1234567890';
  24.  
  25.   FUNCTION specialDos : Boolean;
  26.   VAR VerSwap    : Word;
  27.   BEGIN
  28.     VerSwap := 100*Lo(DosVersion)+Hi(DosVersion);
  29.     specialDos := (VerSwap > 319) AND (VerSwap < 330);
  30.   END;
  31.  
  32.   FUNCTION getDosPSP : Word;
  33.   VAR
  34.     i     : Integer;
  35.     tent  : Word;
  36.     tent1 : Word;
  37.   BEGIN
  38.     i := 0;
  39.     tent := MemW[PrefixSeg:$16];
  40.     {Parent process's PSP is at offset $16}
  41.     WHILE error = none DO
  42.       BEGIN
  43.         tent1 := MemW[tent:$16];
  44.         i := i+1;
  45.         IF ((tent1 = 0) OR (tent1 = tent)) THEN 
  46.           {if this PSP is its own parent...}
  47.           BEGIN
  48.             getDosPSP := tent;
  49.             Exit;
  50.           END
  51.         ELSE tent := tent1;
  52.         IF i = 8 THEN error := envNotFound;
  53.         {try to find the root shell 8 times}
  54.       END;
  55.   END;
  56.  
  57.   PROCEDURE getEnv;
  58.   VAR DosPSP, temp   : Word;
  59.   BEGIN
  60.     DosPSP := getDosPSP;
  61.     temp := MemW[DosPSP:$2C];
  62.     IF ((temp <> 0) AND (NOT specialDos)) THEN
  63.       envSeg := temp
  64.     ELSE envSeg := DosPSP + MemW[DosPSP-1:3]+1;
  65.     {calculate envSeg by adding SIZE of command shell to
  66.      its starting address.  DosPSP-1 is address of MCB
  67.      corresponding to shell, and size is at offset 3}
  68.     envSize := 16*MemW[envSeg-1:3];
  69.   END;
  70.  
  71.   PROCEDURE validate;
  72.   {verifies the address determined by getEnv is       }
  73.   { correct by comparing the contents of the possible }
  74.   { environment to those in the program environment   }
  75.   VAR                             
  76.     i       : Integer;
  77.     j       : Word;
  78.     k       : Integer;
  79.     envName : String[255];
  80.   BEGIN
  81.     j := 0;
  82.     k := 1;
  83.     WHILE (Mem[envSeg:j] > 0) AND (error = none) AND (j < envSize) DO
  84.       BEGIN
  85.         i := 1;
  86.         IF k <= ENVCOUNT THEN
  87.           BEGIN
  88.             envName := ENVSTR(k);
  89.             IF Copy(envName, 1, 4) = 'KEY=' THEN
  90.               BEGIN
  91.                 oldKey := envName;
  92.                 envPos := j;
  93.               END;
  94.           END
  95.         ELSE error := invalidEnv;
  96.         WHILE (Mem[envSeg:j] > 0) AND
  97.               (error = none) AND
  98.               (j < envSize) DO
  99.           BEGIN
  100.             IF i < 256 THEN
  101.                {it is theoretically possible for an  }
  102.                {environmental variable to be longer  }
  103.                {than 255 characters,                 }
  104.               IF (Char(Mem[envSeg:j]) <> envName[i]) THEN
  105.                 error := invalidEnv;
  106.             j := j+1;
  107.             i := i+1;
  108.           END;
  109.         j := j+1;
  110.         k := k+1;
  111.       END;
  112.     envInUse := j+1;
  113.     IF envInUse > envSize THEN error := invalidEnv;
  114.   END;
  115.  
  116.   PROCEDURE changeEnv;
  117.   {adds KEY to the environment if there is enough room }
  118.   { or changes KEY if it already exists and there is   }
  119.   { enough room                                        }
  120.   VAR                             
  121.     diff : Integer;
  122.     j    : Integer;
  123.   BEGIN
  124.     IF oldKey = '' THEN           {if KEY does not exist already}
  125.       BEGIN
  126.         IF envInUse + Length(newKey)+1 <= envSize THEN
  127.           {if there's room}
  128.           BEGIN                   {add KEY to the environment}
  129.             envPos := envInUse-2; {add KEY before the first 0 if KEY}
  130.             IF envPos > 0 THEN    { is the only variable in the     }
  131.             envPos := envPos+1;   { environment, after if it isn't  }
  132.             FOR j := 0 TO Length(newKey)-1 DO
  133.               Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
  134.             MemW[envSeg:envPos+Length(newKey)] := 0;
  135.           END
  136.         ELSE error := envTooSmall;
  137.       END
  138.     ELSE                          {if KEY already exists}
  139.       BEGIN
  140.         diff := Length(newKey)-Length(oldKey);
  141.         IF envInUse+diff+1 <= envSize THEN {if there's room}
  142.           BEGIN
  143.             IF diff = 0 THEN      {if the KEY is the same length}
  144.               BEGIN               {change the value of KEY}
  145.                 FOR j := 0 TO Length(newKey)-1 DO
  146.                   Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
  147.               END;
  148.             IF diff < 0 THEN      {if the new KEY is shorter, change}
  149.               BEGIN               {change the value of KEY, then    }
  150.                                   {move environment past KEY back   }
  151.                 FOR j := 0 TO Length(newKey)-1 DO { to end of KEY   }
  152.                   Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
  153.                 FOR j := envPos+Length(oldKey) TO envInUse-1 DO
  154.                   Mem[envSeg:j+diff] := Mem[envSeg:j];
  155.               END;
  156.             IF diff > 0 THEN      {if the new KEY is longer, move   }
  157.               BEGIN               {the environment past the end of  }
  158.                                   {KEY forward, then change the     }
  159.                                   { value of KEY  }
  160.                 FOR j := envInUse-1 DOWNTO envPos+Length(oldKey) DO
  161.                   Mem[envSeg:j+diff] := Mem[envSeg:j];
  162.                 FOR j := 0 TO Length(newKey)-1 DO
  163.                   Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
  164.               END;
  165.           END
  166.         ELSE error := envTooSmall;
  167.       END;
  168.   END;
  169.  
  170.   FUNCTION key : String;
  171.   VAR keyTyped : String2;
  172.   {returns the value to be stored in environment}
  173.   BEGIN
  174.     keyTyped[1] := READKEY;
  175.     IF keyTyped[1] = #0 THEN keyTyped[2] := READKEY;
  176.     CASE keyTyped[1] OF
  177.       #8 : key := 'BACK';         {sBACK,^H}
  178.       #9 : key := 'TAB';          {^I}
  179.       #10 : key := '^ENTER';      {^J}
  180.       #13 : key := 'ENTER';       {sENTER,^M}
  181.       #1..#26 : key := '^'+Chr(64+Ord(keyTyped[1])); {^A to ^Z}
  182.       #27 : key := 'ESC';         {sESC,^ESC,^[}
  183.       #28 : key := '^\';
  184.       #29 : key := '^]';
  185.       #30 : key := '^6';
  186.       #31 : key := '^-';
  187.       #32 : key := 'SPACE';
  188.       #97..#122 : IF paramFound THEN  {lowercase letters}
  189.                     key := Chr(Ord(keyTyped[1])-32) {to uppercase}
  190.                   ELSE key := keyTyped[1]; {leave in lowercase}
  191.       #127 : key := '^BACK';
  192.       #33..#126 : key := keyTyped[1];
  193.       #0 : CASE keyTyped[2] OF
  194.         #3 : key := '^2';
  195.         #15 : key := 'sTAB';
  196.         #16..#25 : key := 'a'+topRow[Ord(keyTyped[2])-15];
  197.         #30..#38 : key := 'a'+midRow[Ord(keyTyped[2])-29];
  198.         #44..#50 : key := 'a'+botRow[Ord(keyTyped[2])-43];
  199.         #59..#67 : key := 'F'+numbers[Ord(keyTyped[2])-58];
  200.         #68 : key := 'F10';
  201.         #71 : key := 'HOME';
  202.         #72 : key := 'UP';
  203.         #73 : key := 'PGUP';
  204.         #75 : key := 'LF';
  205.         #77 : key := 'RT';
  206.         #79 : key := 'END';
  207.         #80 : key := 'DN';
  208.         #81 : key := 'PGDN';
  209.         #82 : key := 'INS';
  210.         #83 : key := 'DEL';
  211.         #84..#92 : key := 'sF'+numbers[Ord(keyTyped[2])-83];
  212.         #93 : key := 'sF10';
  213.         #94..#102 : key := '^F'+numbers[Ord(keyTyped[2])-93];
  214.         #103 : key := '^F10';
  215.         #104..#112 : key := 'aF'+numbers[Ord(keyTyped[2])-103];
  216.         #113 : key := 'aF10';
  217.         #114 : key := '^*';
  218.         #115 : key := '^LF';
  219.         #116 : key := '^RT';
  220.         #117 : key := '^END';
  221.         #118 : key := '^PGDN';
  222.         #119 : key := '^HOME';
  223.         #120..#129 : key := 'a'+numbers[Ord(keyTyped[2])-119];
  224.         #130 : key := 'a-';
  225.         #131 : key := 'a=';
  226.         #132 : key := '^PGUP';
  227.         ELSE key := 'ERR';
  228.       END;
  229.       ELSE key := 'ERR';
  230.     END;
  231.   END;
  232.  
  233.   PROCEDURE findParam;
  234.   {determines whether the /u parameter was used}
  235.   VAR i : Word;
  236.   BEGIN
  237.     paramFound := False;
  238.     IF ParamCount > 0 THEN
  239.       FOR i := 1 TO ParamCount DO
  240.         IF (ParamStr(i) = '/u') OR(ParamStr(i) = '/U') THEN
  241.         paramFound := True;
  242.   END;
  243.  
  244. BEGIN
  245.   error := none;
  246.   oldKey := '';
  247.   getEnv;
  248.   findParam;
  249.   IF error = none THEN
  250.     BEGIN
  251.       validate;
  252.       IF error = none THEN
  253.         BEGIN
  254.           newKey := 'KEY='+key;
  255.           IF error = none THEN changeEnv;
  256.         END;
  257.     END;
  258.   IF error = envNotFound THEN
  259.     WriteLn('ERROR -- Environment not found');
  260.   IF error = invalidEnv THEN
  261.     WriteLn('ERROR -- Found something...but not the environment');
  262.   IF error = envTooSmall THEN
  263.     WriteLn('ERROR -- Environment is too small');
  264. END.
  265.