home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
01
/
inkey
/
inkey.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-10
|
9KB
|
265 lines
{$D-,L-,R-,S-}
PROGRAM inkey;
USES CRT, DOS;
TYPE
string2 = String[2];
errortype = (none, envNotFound, invalidEnv, envTooSmall);
VAR
envInUse : Word; {bytes in environment up to 1st double 0 }
envPos : Word; {location of KEY in environment }
envSeg : Word; {address of environment }
envSize : Word; {maximum size of environment }
error : errortype; {errors finding environment }
newKey : String; {new value for KEY }
oldKey : String; {KEY when initially run if any }
paramFound : Boolean; {if the parameter /u is in command line }
CONST
topRow : String[10] = 'QWERTYUIOP';
midRow : String[09] = 'ASDFGHJKL';
botRow : String[07] = 'ZXCVBNM';
numbers : String[10] = '1234567890';
FUNCTION specialDos : Boolean;
VAR VerSwap : Word;
BEGIN
VerSwap := 100*Lo(DosVersion)+Hi(DosVersion);
specialDos := (VerSwap > 319) AND (VerSwap < 330);
END;
FUNCTION getDosPSP : Word;
VAR
i : Integer;
tent : Word;
tent1 : Word;
BEGIN
i := 0;
tent := MemW[PrefixSeg:$16];
{Parent process's PSP is at offset $16}
WHILE error = none DO
BEGIN
tent1 := MemW[tent:$16];
i := i+1;
IF ((tent1 = 0) OR (tent1 = tent)) THEN
{if this PSP is its own parent...}
BEGIN
getDosPSP := tent;
Exit;
END
ELSE tent := tent1;
IF i = 8 THEN error := envNotFound;
{try to find the root shell 8 times}
END;
END;
PROCEDURE getEnv;
VAR DosPSP, temp : Word;
BEGIN
DosPSP := getDosPSP;
temp := MemW[DosPSP:$2C];
IF ((temp <> 0) AND (NOT specialDos)) THEN
envSeg := temp
ELSE envSeg := DosPSP + MemW[DosPSP-1:3]+1;
{calculate envSeg by adding SIZE of command shell to
its starting address. DosPSP-1 is address of MCB
corresponding to shell, and size is at offset 3}
envSize := 16*MemW[envSeg-1:3];
END;
PROCEDURE validate;
{verifies the address determined by getEnv is }
{ correct by comparing the contents of the possible }
{ environment to those in the program environment }
VAR
i : Integer;
j : Word;
k : Integer;
envName : String[255];
BEGIN
j := 0;
k := 1;
WHILE (Mem[envSeg:j] > 0) AND (error = none) AND (j < envSize) DO
BEGIN
i := 1;
IF k <= ENVCOUNT THEN
BEGIN
envName := ENVSTR(k);
IF Copy(envName, 1, 4) = 'KEY=' THEN
BEGIN
oldKey := envName;
envPos := j;
END;
END
ELSE error := invalidEnv;
WHILE (Mem[envSeg:j] > 0) AND
(error = none) AND
(j < envSize) DO
BEGIN
IF i < 256 THEN
{it is theoretically possible for an }
{environmental variable to be longer }
{than 255 characters, }
IF (Char(Mem[envSeg:j]) <> envName[i]) THEN
error := invalidEnv;
j := j+1;
i := i+1;
END;
j := j+1;
k := k+1;
END;
envInUse := j+1;
IF envInUse > envSize THEN error := invalidEnv;
END;
PROCEDURE changeEnv;
{adds KEY to the environment if there is enough room }
{ or changes KEY if it already exists and there is }
{ enough room }
VAR
diff : Integer;
j : Integer;
BEGIN
IF oldKey = '' THEN {if KEY does not exist already}
BEGIN
IF envInUse + Length(newKey)+1 <= envSize THEN
{if there's room}
BEGIN {add KEY to the environment}
envPos := envInUse-2; {add KEY before the first 0 if KEY}
IF envPos > 0 THEN { is the only variable in the }
envPos := envPos+1; { environment, after if it isn't }
FOR j := 0 TO Length(newKey)-1 DO
Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
MemW[envSeg:envPos+Length(newKey)] := 0;
END
ELSE error := envTooSmall;
END
ELSE {if KEY already exists}
BEGIN
diff := Length(newKey)-Length(oldKey);
IF envInUse+diff+1 <= envSize THEN {if there's room}
BEGIN
IF diff = 0 THEN {if the KEY is the same length}
BEGIN {change the value of KEY}
FOR j := 0 TO Length(newKey)-1 DO
Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
END;
IF diff < 0 THEN {if the new KEY is shorter, change}
BEGIN {change the value of KEY, then }
{move environment past KEY back }
FOR j := 0 TO Length(newKey)-1 DO { to end of KEY }
Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
FOR j := envPos+Length(oldKey) TO envInUse-1 DO
Mem[envSeg:j+diff] := Mem[envSeg:j];
END;
IF diff > 0 THEN {if the new KEY is longer, move }
BEGIN {the environment past the end of }
{KEY forward, then change the }
{ value of KEY }
FOR j := envInUse-1 DOWNTO envPos+Length(oldKey) DO
Mem[envSeg:j+diff] := Mem[envSeg:j];
FOR j := 0 TO Length(newKey)-1 DO
Mem[envSeg:envPos+j] := Ord(newKey[j+1]);
END;
END
ELSE error := envTooSmall;
END;
END;
FUNCTION key : String;
VAR keyTyped : String2;
{returns the value to be stored in environment}
BEGIN
keyTyped[1] := READKEY;
IF keyTyped[1] = #0 THEN keyTyped[2] := READKEY;
CASE keyTyped[1] OF
#8 : key := 'BACK'; {sBACK,^H}
#9 : key := 'TAB'; {^I}
#10 : key := '^ENTER'; {^J}
#13 : key := 'ENTER'; {sENTER,^M}
#1..#26 : key := '^'+Chr(64+Ord(keyTyped[1])); {^A to ^Z}
#27 : key := 'ESC'; {sESC,^ESC,^[}
#28 : key := '^\';
#29 : key := '^]';
#30 : key := '^6';
#31 : key := '^-';
#32 : key := 'SPACE';
#97..#122 : IF paramFound THEN {lowercase letters}
key := Chr(Ord(keyTyped[1])-32) {to uppercase}
ELSE key := keyTyped[1]; {leave in lowercase}
#127 : key := '^BACK';
#33..#126 : key := keyTyped[1];
#0 : CASE keyTyped[2] OF
#3 : key := '^2';
#15 : key := 'sTAB';
#16..#25 : key := 'a'+topRow[Ord(keyTyped[2])-15];
#30..#38 : key := 'a'+midRow[Ord(keyTyped[2])-29];
#44..#50 : key := 'a'+botRow[Ord(keyTyped[2])-43];
#59..#67 : key := 'F'+numbers[Ord(keyTyped[2])-58];
#68 : key := 'F10';
#71 : key := 'HOME';
#72 : key := 'UP';
#73 : key := 'PGUP';
#75 : key := 'LF';
#77 : key := 'RT';
#79 : key := 'END';
#80 : key := 'DN';
#81 : key := 'PGDN';
#82 : key := 'INS';
#83 : key := 'DEL';
#84..#92 : key := 'sF'+numbers[Ord(keyTyped[2])-83];
#93 : key := 'sF10';
#94..#102 : key := '^F'+numbers[Ord(keyTyped[2])-93];
#103 : key := '^F10';
#104..#112 : key := 'aF'+numbers[Ord(keyTyped[2])-103];
#113 : key := 'aF10';
#114 : key := '^*';
#115 : key := '^LF';
#116 : key := '^RT';
#117 : key := '^END';
#118 : key := '^PGDN';
#119 : key := '^HOME';
#120..#129 : key := 'a'+numbers[Ord(keyTyped[2])-119];
#130 : key := 'a-';
#131 : key := 'a=';
#132 : key := '^PGUP';
ELSE key := 'ERR';
END;
ELSE key := 'ERR';
END;
END;
PROCEDURE findParam;
{determines whether the /u parameter was used}
VAR i : Word;
BEGIN
paramFound := False;
IF ParamCount > 0 THEN
FOR i := 1 TO ParamCount DO
IF (ParamStr(i) = '/u') OR(ParamStr(i) = '/U') THEN
paramFound := True;
END;
BEGIN
error := none;
oldKey := '';
getEnv;
findParam;
IF error = none THEN
BEGIN
validate;
IF error = none THEN
BEGIN
newKey := 'KEY='+key;
IF error = none THEN changeEnv;
END;
END;
IF error = envNotFound THEN
WriteLn('ERROR -- Environment not found');
IF error = invalidEnv THEN
WriteLn('ERROR -- Found something...but not the environment');
IF error = envTooSmall THEN
WriteLn('ERROR -- Environment is too small');
END.