Jelajahi Sumber

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

marco 22 tahun lalu
induk
melakukan
88af0dddd6
1 mengubah file dengan 245 tambahan dan 0 penghapusan
  1. 245 0
      rtl/unix/unixutil.pp

+ 245 - 0
rtl/unix/unixutil.pp

@@ -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.