mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 16:59:26 +02:00
140 lines
3.2 KiB
PHP
140 lines
3.2 KiB
PHP
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2002 by Marco van de Voort.
|
|
|
|
A few general purpose routines. General purpose enough for *BSD
|
|
and Linux at least.
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
|
|
{
|
|
Create an argv which executes a command in a shell using /bin/sh -c
|
|
}
|
|
const Shell = '/bin/sh'#0'-c'#0;
|
|
var
|
|
pp,p : ppchar;
|
|
// temp : string; !! Never pass a local var back!!
|
|
begin
|
|
getmem(pp,4*4);
|
|
p:=pp;
|
|
p^:=@Shell[1];
|
|
inc(p);
|
|
p^:=@Shell[9];
|
|
inc(p);
|
|
getmem(p^,len+1);
|
|
move(cmd^,p^^,len);
|
|
pchar(p^)[len]:=#0;
|
|
inc(p);
|
|
p^:=Nil;
|
|
InternalCreateShellArgV:=pp;
|
|
end;
|
|
|
|
function CreateShellArgV(const prog:string):ppchar;
|
|
begin
|
|
CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
|
|
end;
|
|
|
|
function CreateShellArgV(const prog:Ansistring):ppchar;
|
|
{
|
|
Create an argv which executes a command in a shell using /bin/sh -c
|
|
using a AnsiString;
|
|
}
|
|
begin
|
|
CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
|
|
end;
|
|
|
|
|
|
procedure FreeShellArgV(p:ppchar);
|
|
begin
|
|
if (p<>nil) then begin
|
|
freemem(p[2]);
|
|
freemem(p);
|
|
end;
|
|
end;
|
|
|
|
{$ifndef FPC_USE_LIBC}
|
|
Function fpgetenv(name:pchar):pchar;
|
|
|
|
var
|
|
p : ppchar;
|
|
found : boolean;
|
|
np,cp : pchar;
|
|
len,i : longint;
|
|
Begin
|
|
if (name=nil) or (envp=NIL) Then
|
|
exit(NIL);
|
|
np:=name;
|
|
while (np^<>#0) and (np^<>'=') DO
|
|
inc(np);
|
|
len:=np-name;
|
|
p:=envp;
|
|
while (p^<>NIL) DO
|
|
Begin
|
|
cp:=p^;
|
|
np:=name;
|
|
i:=len;
|
|
while (i<>0) and (cp^<>#0) DO
|
|
Begin
|
|
if cp^<>np^ Then
|
|
Begin
|
|
inc(cp); inc(np);
|
|
break;
|
|
End;
|
|
inc(cp); inc(np);
|
|
dec(i)
|
|
End;
|
|
if (i=0) and (cp^='=') Then
|
|
exit(cp+1);
|
|
inc(p);
|
|
end;
|
|
fpgetenv:=nil;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
Function fpgetenv(name:string):Pchar; [public, alias : 'FPC_SYSC_FPGETENV'];
|
|
{
|
|
Searches the environment for a string with name p and
|
|
returns a pchar to it's value.
|
|
A pchar is used to accomodate for strings of length > 255
|
|
}
|
|
|
|
Begin
|
|
{$ifndef FPC_USE_LIBC}
|
|
name:=name+'='; {Else HOST will also find HOSTNAME, etc}
|
|
{$else}
|
|
name:=name+#0;
|
|
{$endif}
|
|
fpgetenv:=fpgetenv(@name[1]);
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.4 2004-01-01 14:07:55 marco
|
|
* FPC_USE_LIBC fixes to fpgetenv. No more appending of '=', and making a proper nullterminated string)
|
|
|
|
Revision 1.3 2003/12/30 12:24:01 marco
|
|
* FPC_USE_LIBC
|
|
|
|
Revision 1.2 2003/09/14 20:15:01 marco
|
|
* Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
|
|
|
|
Revision 1.1 2002/12/18 16:50:39 marco
|
|
* Unix RTL generic parts. Linux working, *BSD will follow shortly
|
|
|
|
Revision 1.2 2002/10/27 17:21:30 marco
|
|
* Only "difficult" functions + execvp + termios + rewinddir left to do
|
|
|
|
Revision 1.1 2002/10/27 13:16:54 marco
|
|
* Routines that certainly will be shared between Linux and *BSD
|
|
|
|
|
|
} |