From c70d9ccc3e62fef849e6694d12f44fdbdc7b5e22 Mon Sep 17 00:00:00 2001 From: peter Date: Fri, 13 Apr 2001 18:05:34 +0000 Subject: [PATCH] * win32 getenv version --- rtl/inc/heaptrc.pp | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index 95391dfd49..14542e61f6 100644 --- a/rtl/inc/heaptrc.pp +++ b/rtl/inc/heaptrc.pp @@ -1051,6 +1051,35 @@ begin end; end; +{$ifdef win32} + function GetEnvironmentStrings : pchar; + external 'kernel32' name 'GetEnvironmentStringsA'; + function FreeEnvironmentStrings(p : pchar) : longbool; + external 'kernel32' name 'FreeEnvironmentStringsA'; +Function GetEnv(envvar: string): string; +var + s : string; + i : longint; + hp,p : pchar; +begin + getenv:=''; + p:=GetEnvironmentStrings; + hp:=p; + while hp^<>#0 do + begin + s:=strpas(hp); + i:=pos('=',s); + if upcase(copy(s,1,i-1))=upcase(envvar) then + begin + getenv:=copy(s,i+1,length(s)-i); + break; + end; + { next string entry} + hp:=hp+strlen(hp)+1; + end; + FreeEnvironmentStrings(p); +end; +{$else} Function GetEnv(P:string):Pchar; { Searches the environment for a string with name p and @@ -1085,7 +1114,7 @@ Begin else getenv:=nil; end; - +{$endif} procedure LoadEnvironment; var @@ -1123,7 +1152,10 @@ finalization end. { $Log$ - Revision 1.10 2001-04-13 01:18:08 peter + Revision 1.11 2001-04-13 18:05:34 peter + * win32 getenv version + + Revision 1.10 2001/04/13 01:18:08 peter * always clear memory in getmem and freemem Revision 1.8 2001/04/11 14:08:31 peter