mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:19:31 +01: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