* Initial version. Plain vanilla copy and paste from unix.pp

This commit is contained in:
marco 2003-09-17 17:24:45 +00:00
parent feee65f98f
commit 88af0dddd6

245
rtl/unix/unixutil.pp Normal file
View File

@ -0,0 +1,245 @@
unit unixutil;
interface
Type
ComStr = String[255];
PathStr = String[255];
DirStr = String[255];
NameStr = String[255];
ExtStr = String[255];
Function Dirname(Const path:pathstr):pathstr;
Function StringToPPChar(S: PChar):ppchar;
Function StringToPPChar(Var S:String):ppchar;
Function StringToPPChar(Var S:AnsiString):ppchar;
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
Function FNMatch(const Pattern,Name:string):Boolean;
Function GetFS (var T:Text):longint;
Function GetFS(Var F:File):longint;
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
implementation
{$I textrec.inc}
{$i filerec.inc}
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
Var
DotPos,SlashPos,i : longint;
Begin
SlashPos:=0;
DotPos:=256;
i:=Length(Path);
While (i>0) and (SlashPos=0) Do
Begin
If (DotPos=256) and (Path[i]='.') Then
begin
DotPos:=i;
end;
If (Path[i]='/') Then
SlashPos:=i;
Dec(i);
End;
Ext:=Copy(Path,DotPos,255);
Dir:=Copy(Path,1,SlashPos);
Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
End;
Function Dirname(Const path:pathstr):pathstr;
{
This function returns the directory part of a complete path.
Unless the directory is root '/', The last character is not
a slash.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if length(Dir)>1 then
Delete(Dir,length(Dir),1);
DirName:=Dir;
end;
Function StringToPPChar(Var S:String):ppchar;
{
Create a PPChar to structure of pchars which are the arguments specified
in the string S. Especially usefull for creating an ArgV for Exec-calls
Note that the string S is destroyed by this call.
}
begin
S:=S+#0;
StringToPPChar:=StringToPPChar(@S[1]);
end;
Function StringToPPChar(Var S:AnsiString):ppchar;
{
Create a PPChar to structure of pchars which are the arguments specified
in the string S. Especially usefull for creating an ArgV for Exec-calls
}
begin
StringToPPChar:=StringToPPChar(PChar(S));
end;
Function StringToPPChar(S: PChar):ppchar;
var
nr : longint;
Buf : ^char;
p : ppchar;
begin
buf:=s;
nr:=0;
while(buf^<>#0) do
begin
while (buf^ in [' ',#9,#10]) do
inc(buf);
inc(nr);
while not (buf^ in [' ',#0,#9,#10]) do
inc(buf);
end;
getmem(p,nr*4);
StringToPPChar:=p;
if p=nil then
begin
{$ifdef xunix}
fpseterrno(ESysEnomem);
{$endif}
exit;
end;
buf:=s;
while (buf^<>#0) do
begin
while (buf^ in [' ',#9,#10]) do
begin
buf^:=#0;
inc(buf);
end;
p^:=buf;
inc(p);
p^:=nil;
while not (buf^ in [' ',#0,#9,#10]) do
inc(buf);
end;
end;
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
{
This function returns the filename part of a complete path. If suf is
supplied, it is cut off the filename.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if Suf<>Ext then
Name:=Name+Ext;
BaseName:=Name;
end;
Function FNMatch(const Pattern,Name:string):Boolean;
Var
LenPat,LenName : longint;
Function DoFNMatch(i,j:longint):Boolean;
Var
Found : boolean;
Begin
Found:=true;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' : Found:=(j<=LenName);
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found and (i<LenPat) do
begin
inc(i);
case Pattern[i] of
'*' : ;
'?' : begin
inc(j);
Found:=(j<=LenName);
end;
else
Found:=false;
end;
end;
{Now, find in name the character which i points to, if the * or ?
wasn't the last character in the pattern, else, use up all the
chars in name}
Found:=true;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
while (j<=LenName) and (name[j]<>pattern[i]) do
inc (j);
if (j<LenName) then
begin
if DoFnMatch(i+1,j+1) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
end
else
inc(j);{We didn't find one, need to look further}
end;
until (j>=LenName);
end
else
j:=LenName;{we can stop}
end;
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
end;
inc(i);
inc(j);
end;
DoFnMatch:=Found and (j>LenName);
end;
Begin {start FNMatch}
LenPat:=Length(Pattern);
LenName:=Length(Name);
FNMatch:=DoFNMatch(1,1);
End;
Function GetFS (var T:Text):longint;
{
Get File Descriptor of a text file.
}
begin
if textrec(t).mode=fmclosed then
exit(-1)
else
GETFS:=textrec(t).Handle
end;
Function GetFS(Var F:File):longint;
{
Get File Descriptor of an unTyped file.
}
begin
{ Handle and mode are on the same place in textrec and filerec. }
if filerec(f).mode=fmclosed then
exit(-1)
else
GETFS:=filerec(f).Handle
end;
end.