{ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by the Free Pascal development team See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} { --------------------------------------------------------------------- Environment variable auxiliary routines ---------------------------------------------------------------------} Const FPC_EnvCount : Integer = -1; Function FPCCountEnvVar(EP : PPChar) : integer; begin If (FPC_EnvCount=-1) then begin FPC_EnvCount:=0; If (EP<>Nil) then While (EP^<>Nil) do begin Inc(FPC_EnvCount); Inc(EP); end; end; Result:=FPC_EnvCount; end; Function FPCGetEnvVarFromP(EP : PPChar; EnvVar : String) : String; var hp : ppchar; lenvvar,hs : string; eqpos : longint; begin lenvvar:=upcase(envvar); hp:=EP; Result:=''; If (hp<>Nil) then while assigned(hp^) do begin hs:=strpas(hp^); eqpos:=pos('=',hs); if upcase(copy(hs,1,eqpos-1))=lenvvar then begin Result:=copy(hs,eqpos+1,length(hs)-eqpos); exit; end; inc(hp); end; end; Function FPCGetEnvStrFromP(EP : PPChar; Index : Integer) : String; begin Result:=''; while assigned(EP^) and (Index>1) do begin Dec(Index); inc(EP); end; If Assigned(EP^) then Result:=StrPas(EP^); end; { --------------------------------------------------------------------- Application name ---------------------------------------------------------------------} Function ApplicationName : String; begin If Assigned(OnGetApplicationName) then Result:=OnGetApplicationName() else Result:=ChangeFileExt(ExtractFileName(Paramstr(0)),''); end; { --------------------------------------------------------------------- Default implementations for AppConfigDir implementation. ---------------------------------------------------------------------} Function DGetAppConfigDir(Global : Boolean) : String; begin Result:=ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))); end; Function DGetAppConfigFile(Global : Boolean; SubDir : Boolean) : String; begin Result:=ExtractFilePath(ParamStr(0)); If SubDir then Result:=IncludeTrailingPathDelimiter(Result+ApplicationName); Result:=Result+ApplicationName+ConfigExtension; end; Function GetAppConfigFile(Global : Boolean) : String; begin Result:=GetAppConfigFile(Global,False); end; { --------------------------------------------------------------------- Fallback implementations for AppConfigDir implementation. ---------------------------------------------------------------------} { If a particular OS does it different: - set the HAVE_OSCONFIG define before including sysutils.inc. - implement the functions. Default config assumes a DOS-like configuration. } {$ifndef HAS_OSCONFIG} Function GetAppConfigDir(Global : Boolean) : String; begin Result:=DGetAppConfigDir(Global); end; Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String; begin Result:=DGetAppConfigFile(Global,Subdir); end; {$endif} { --------------------------------------------------------------------- Get temporary directory name ---------------------------------------------------------------------} {$ifndef HAS_TEMPDIR} Function GetTempDir(Global : Boolean) : String; begin If Assigned(OnGetTempDir) then Result:=OnGetTempDir(Global) else begin Result:=GetEnvironmentVariable('TEMP'); If (Result='') Then Result:=GetEnvironmentVariable('TMP'); end; if (Result<>'') then Result:=IncludeTrailingPathDelimiter(Result); end; {$endif} Function GetTempDir : String; begin Result:=GetTempDir(True); end; { --------------------------------------------------------------------- Get temporary file name ---------------------------------------------------------------------} {$ifndef HAS_TEMPFILE} Function GetTempFileName(Const Dir,Prefix : String) : String; Var I : Integer; Start : String; begin If Assigned(OnGetTempFile) then Result:=OnGetTempFile(Dir,Prefix) else begin If (Dir='') then Start:=GetTempDir else Start:=IncludeTrailingPathDelimiter(Dir); If (Prefix='') then Start:=Start+'TMP' else Start:=Start+Prefix; I:=0; Repeat Result:=Format('%s%.5d.tmp',[Start,I]); Inc(I); Until not FileExists(Result); end; end; {$endif} Function GetTempFileName : String; begin Result:=GetTempFileName('',''); end; {$ifndef win32} Function GetTempFileName(Dir,Prefix: PChar; uUnique: DWORD; TempFileName: PChar):DWORD; Var P,Buf : String; L : Integer; begin P:=StrPas(Prefix); if (uUnique<>0) then P:=P+format('%.4x',[uUnique]); Buf:=GetTempFileName(StrPas(Dir),P); L:=Length(Buf); If (L>0) then Move(Buf[1],TempFileName^,L+1); if (uUnique<>0) then result:=uUnique else result:=1; end; {$endif}