mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 09:39:25 +02:00
* Initial version. Plain vanilla copy and paste from unix.pp
This commit is contained in:
parent
feee65f98f
commit
88af0dddd6
245
rtl/unix/unixutil.pp
Normal file
245
rtl/unix/unixutil.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user