fpc/rtl/objpas/sysutils/osutil.inc

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team

    <What does this file>
    
    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;

{  
  $Log$
  Revision 1.3  2004-12-11 11:33:15  michael
  + Added GetEnvironmentVariableCount and GetEnvironmentString calls

  Revision 1.2  2004/10/10 10:28:34  michael
  + Implementation of GetTempDir and GetTempFileName

  Revision 1.1  2004/08/05 07:28:01  michael
  + Added getappconfigdir calls

}