fpc/rtl/objpas/sysutils/osutil.inc

{
    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 VendorName : String;

begin
  If Assigned(OnGetVendorName) then
    Result:=OnGetVendorName()
  else
    Result:='';
end;

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:=IncludeTrailingPathDelimiter(GetAppConfigDir(Global));
  if SubDir then
    Result:=IncludeTrailingPathDelimiter(Result+'Config');
  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;

{$if not(defined(win32)) and not(defined(win64))}
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}