{ This file is part of the Free Pascal run time library. Copyright (c) 1999-2013 by the Free Pascal development team DO NOT ADD ROUTINES TO THIS FILE! THE ROUTINES IN THIS FILE ARE INTERNAL AND NOT FOR END USER USAGE! Background: This unit contains leftovers from the unix restructure that shouldn't be in the interface of unit baseunix/unix, but are needed in these units. (at the time routines were still being moved from baseunix to unix, and unit baseunix couldn't depend on unix) The routines are fairly OS independent but can't move to OS independent because the lowlevel units baseunix/unix depend on them. If they need to be generally accessable, copy these functions to a general purpose, OS independent, supportable unit. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit unixutil; interface var Tzseconds : Longint; Type ComStr = String[255] deprecated 'Clean up shortstring use, or use same type from unit dos.'; PathStr = String[255] deprecated 'Clean up shortstring use, or use same type from unit dos.'; DirStr = String[255] deprecated 'Clean up shortstring use, or use same type from unit dos.'; NameStr = String[255] deprecated 'Clean up shortstring use, or use same type from unit dos.'; ExtStr = String[255] deprecated 'Clean up shortstring use, or use same type from unit dos.'; Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar; Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar; function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ? Function GetFS(var T:Text):longint; deprecated; Function GetFS(Var F:File):longint; deprecated; // use sysutils.getfilehandle 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 function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ? // Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?) // Note: for internal use by skilled programmers only // if "s" goes out of scope in the parent procedure, the pointer is dangling. var p : ppchar; i : LongInt; begin if High(s)#0) do // count nr of args begin while (buf^ in [' ',#9,#10]) do // Kill separators. inc(buf); inc(nr); if buf^='"' Then // quotes argument? begin inc(buf); while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote inc(buf); if buf^='"' then // skip closing quote. inc(buf); end else begin // else std while not (buf^ in [' ',#0,#9,#10]) do inc(buf); end; end; getmem(p,(ReserveEntries+nr)*sizeof(pchar)); StringToPPChar:=p; if p=nil then begin {$ifdef xunix} fpseterrno(ESysEnomem); {$endif} exit; end; for i:=1 to ReserveEntries do inc(p); // skip empty slots buf:=s; while (buf^<>#0) do begin while (buf^ in [' ',#9,#10]) do // Kill separators. begin buf^:=#0; inc(buf); end; if buf^='"' Then // quotes argument? begin inc(buf); p^:=buf; inc(p); p^:=nil; while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote inc(buf); if buf^='"' then // skip closing quote. begin buf^:=#0; inc(buf); end; end else begin p^:=buf; inc(p); p^:=nil; while not (buf^ in [' ',#0,#9,#10]) do inc(buf); end; end; 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.