home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
TSPA3260.ZIP
/
TSUNTENV.TST
< prev
next >
Wrap
Text File
|
1993-01-23
|
3KB
|
120 lines
{$M 16384,0,0}
{$R+}
program tsuntenvTest;
uses Dos,
TSUNTENV,
TSUNTE; (* To include the routine getting the command line *)
procedure LOGO;
begin
writeln;
writeln ('TSUNTENV unit test by Prof. Timo Salmi, 23-Jan-93');
writeln ('University of Vaasa, Finland, ts@uwasa.fi');
{$IFDEF VER40}
writeln ('TP version 4.0');
{$ENDIF}
{$IFDEF VER50}
writeln ('TP version 5.0');
{$ENDIF}
{$IFDEF VER55}
writeln ('TP version 5.5');
{$ENDIF}
{$IFDEF VER60}
writeln ('TP version 6.0');
{$ENDIF}
{$IFDEF VER70}
writeln ('TP version 7.0');
{$ENDIF}
writeln;
end; (* logo *)
function HEXFN (decimal : word) : string;
const hexDigit : array [0..15] of char = '0123456789ABCDEF';
begin
hexfn := hexDigit[(decimal shr 12)]
+ hexDigit[(decimal shr 8) and $0F]
+ hexDigit[(decimal shr 4) and $0F]
+ hexDigit[(decimal and $0F)];
end; (* hexfn *)
(* Demonstrate some information about the parent environment *)
procedure TEST1;
var envsize : word;
envuse : word;
envaddr : string;
begin
envsize := ENVSIZFN;
writeln ('The environment size is ', envsize:5, ' bytes');
envuse := ENVUSEFN;
writeln ('The environment use is ', envuse:5, ' bytes');
envaddr := '$' + HEXFN(ENVADDFN);
writeln ('The environment segment address is ', envaddr);
SHOWENV;
end; (* test1 *)
procedure TEST2;
var status : byte;
newset : string;
begin
newset := copy (CMDLNFN, 2, 255); (* From TSUNTE *)
if newset <> '' then
begin
SETENV (newset, status);
case status of
0 : writeln ('No errors detected');
1 : writeln ('Syntax error (Usage: variable=value)', #7);
2 : writeln ('Out of environment space', #7);
3 : writeln ('Missed the variable or the environment', #7);
end;
end
else
writeln ('Usage: TSUNTENV.EXE name=value');
end; (* test2 *)
(* Test setting the invironment variable for the duration of shelling
to MsDos *)
procedure TEST3;
var comspec : string;
error : integer;
begin
{}
comspec := GetEnv ('comspec');
SETENVSH ('TEST_LONG_ENVIRONMENT', 'testing_the_environment');
SETENVSH ('PROMPT', '$p$g[SHELLED] ');
{}
writeln ('Type EXIT to return to TSUNTENV');
writeln ('Write SET to see the current environment variable values');
swapvectors;
Exec (comspec, ''); {execute the DOS shell}
swapvectors;
{}
error := DosError;
if error <> 0 then
begin
writeln ('Cannot run MsDos shell');
if error = 8 then
writeln ('Out of memory')
else
writeln ('Command processor ', comspec, ' not found');
halt;
end;
{}
writeln ('Back from shell');
writeln ('Write SET to see the current environment variable values');
end; (* test3 *)
(* Main program *)
begin
LOGO;
{
TEST3;
TEST1;
}
TEST2;
TEST1;
{}
{ write ('Press <-'' '); readln; }
end. (* tsuntenv.tst *)