Examples Delphi

Title: Read environment variable
Question: How to get process environment variable ?
Answer:
The TEnvironementVariable class allow reading of process environment variables. You can acces to the PATH variable, the processor architecture (on NT) etc... It is usefull when you develop a CGI application without the built-in Delphi WebDispatcher, cause CGI parameters are available in environment variables.
Example :
Env := TEnironementVariable.Create;
for i := 0 to Env.Count - 1 do
begin
Writeln(Env[i]);
end;
Env.Free;
unit U_EnvVar;
{* U_EnvVar - 11/10/2000 - J.Forestier
* Define a class to read environment variables of a process
* Read GetEnvironmentVariable() in MSDN.
*
* Usefull for CGI program
*
* TEnvironementVariable
* Create : retreive environment variables
* AddParamstr : add command line parameters to environment variable (usefull for CGI debuging)
* ReadString, ReadInteger : read the value of an environment variable
* CgiQueryString : get the parameters if the program is CGI called
* CgiParamCount : get the number of parameters for a CGI program
* CgiParamStr : get a parameter for a CGI program
* Count : get the number of environment variables
* Items : get the value of an environment variable (from 0 to count - 1)
*}
interface
uses
Windows, Classes, SysUtils;
Const
CGI_SEPARATORS = ',;?'; // each char represents a token separator.
type
TEnvironementVariable = class
private
FEnvVar : TStringList;
function Get(index : integer) : string;
procedure Put(Index: Integer; const S: string);
public
constructor Create;
destructor Destroy;
procedure AddParamstr;
function ReadString(const Varname, default : string) : string;
function ReadInteger(const VarName : string ; default : integer) : integer;
function CgiQueryString : string;
function CgiParamCount(const separator : string) : integer;
function CgiParamStr(const separator : string ; idx : integer) : string;
function Count : integer;
property Items[Index: Integer]: String read Get ; default; // no write allowed
end;
function ExtractEnvironementVariable(EnvVar : TStringList) : integer;
function GetEnv(const name, default : string ; EnvVar : TStringList) : string;
implementation
const
CGI_QUERY_STRING = 'QUERY_STRING';
constructor TEnvironementVariable.Create;
begin
FEnvVar := TStringList.Create;
ExtractEnvironementVariable(FEnvVar);
end;
destructor TEnvironementVariable.Destroy;
begin
FEnvVar.Destroy;
end;
function TEnvironementVariable.Get(index : integer) : string;
begin
result := FEnvVar[index];
end;
procedure TEnvironementVariable.Put(Index: Integer; const S: string);
begin
FEnvVar[index] := s;
end;
procedure TEnvironementVariable.AddParamstr;
var
i : integer;
begin
for i := 0 to ParamCount do
begin
FEnvVar.Add(ParamStr(i));
end;
end;
function TEnvironementVariable.ReadString(const Varname, default : string) : string;
begin
result := GetEnv(varname, default, FEnvVar);
end;
function TEnvironementVariable.ReadInteger(const VarName : string ; default : integer) : integer;
var
idx : integer;
s : string;
begin
idx := FEnvVar.IndexOfName(varname);
if (idx -1) then
begin
s := FEnvVar[idx];
result := StrToIntDef(copy(s, pos('=', s)+1, length(s)), default);
end
else
result := default;
end;
function TEnvironementVariable.Count : integer;
begin
result := FEnvVar.Count;
end;
function TEnvironementVariable.CgiQueryString : string;
begin
result := ReadString(CGI_QUERY_STRING, '');
end;
function TEnvironementVariable.CgiParamCount(const separator : string) : integer;
var
p : PCHAR;
cnt : integer;
i : integer;
begin
cnt := 0;
p := PCHAR(CgiQueryString);
if (p[0] = #0) then
result := 0
else
begin
while (p[0] #0) do
begin
for i := 1 to length(separator) do
begin
if (separator[i] = p[0]) then
begin
inc(cnt);
break;
end;
end;
inc(p);
end;
result := cnt+1;
end;
end;
function GetFirstPosOfChars(const str : string ; const chars : string) : integer;
var
i,j : integer;
begin
for i := 1 to length(str) do
begin
for j := 1 to length(chars) do
begin
if (str[i] = chars[j]) then
begin
result := i;
exit;
end;
end;
end;
result := -1;
end;
function TEnvironementVariable.CgiParamStr(const separator : string ; idx : integer) : string;
var
p : string;
d,f : integer;
cnt : integer;
begin
p := CgiQueryString;
if (idx = 0) then
begin
f := GetFirstPosOfChars(p, separator);
if (f = -1) then
f := length(p)
else
dec(f);
end
else
begin
cnt := 0;
while (cntidx) do
begin
d := GetFirstPosOfChars(p, separator);
if (d -1) then
inc (cnt)
else
begin
break;
end;
p := copy(p, d+1, length(p));
end;
f := GetFirstPosOfChars(p, separator);
if (f = -1) then
f := length(p)
else
dec(f);
end;
d := 1;
result := Copy(p, d, f);
end;
function ExtractEnvironementVariable(EnvVar : TStringList) : integer;
var
p : PCHAR;
begin
EnvVar.Clear;
p := GetEnvironmentStrings; { p = 'var=val\0var=val\0var=val\0\0' }
while (p[0] #0) do
begin
EnvVar.Add(StrNew(p)); { avoid global env modifing }
inc(p, StrLen(p)+1);
end;
end;
function GetEnv(const name, default : string ; EnvVar : TStringList) : string;
var
idx : integer;
s : string;
begin
idx := EnvVar.IndexOfName(name);
if (idx -1) then
begin
s := EnvVar[idx];
result := copy(s, pos('=', s)+1, length(s))
end
else
result := default;
end;
end.