unit unixutil; interface var Tzseconds : Longint; 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); Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint; Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word); Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word); Function GregorianToJulian(Year,Month,Day:Longint):LongInt; 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 (ipattern[i]) do inc (j); if (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; Const {Date Translation} C1970=2440588; D0 = 1461; D1 = 146097; D2 =1721119; Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word); Var YYear,XYear,Temp,TempMonth : LongInt; Begin Temp:=((JulianDN-D2) shl 2)-1; JulianDN:=Temp Div D1; XYear:=(Temp Mod D1) or 3; YYear:=(XYear Div D0); Temp:=((((XYear mod D0)+4) shr 2)*5)-3; Day:=((Temp Mod 153)+5) Div 5; TempMonth:=Temp Div 153; If TempMonth>=10 Then Begin inc(YYear); dec(TempMonth,12); End; inc(TempMonth,3); Month := TempMonth; Year:=YYear+(JulianDN*100); end; Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word); { Transforms Epoch time into local time (hour, minute,seconds) } Var DateNum: LongInt; Begin inc(Epoch,TZSeconds); Datenum:=(Epoch Div 86400) + c1970; JulianToGregorian(DateNum,Year,Month,day); Epoch:=Abs(Epoch Mod 86400); Hour:=Epoch Div 3600; Epoch:=Epoch Mod 3600; Minute:=Epoch Div 60; Second:=Epoch Mod 60; End; Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint; { Transforms local time (year,month,day,hour,minutes,second) to Epoch time (seconds since 00:00, january 1 1970, corrected for local time zone) } Begin LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+ (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds; End; Function GregorianToJulian(Year,Month,Day:Longint):LongInt; Var Century,XYear: LongInt; Begin If Month<=2 Then Begin Dec(Year); Inc(Month,12); End; Dec(Month,3); Century:=(longint(Year Div 100)*D1) shr 2; XYear:=(longint(Year Mod 100)*D0) shr 2; GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century; End; end.