mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 14:31:38 +01:00
255 lines
7.2 KiB
ObjectPascal
255 lines
7.2 KiB
ObjectPascal
{
|
|
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)<Low(s) Then Exit(NIL);
|
|
Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2)); // one more for NIL, one more
|
|
// for cmd
|
|
if p=nil then
|
|
begin
|
|
{$ifdef xunix}
|
|
fpseterrno(ESysEnomem);
|
|
{$endif}
|
|
exit(NIL);
|
|
end;
|
|
for i:=low(s) to high(s) do
|
|
p[i+Reserveentries]:=pchar(s[i]);
|
|
p[high(s)+1+Reserveentries]:=nil;
|
|
ArrayStringToPPchar:=p;
|
|
end;
|
|
|
|
Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
|
|
{
|
|
Create a PPChar to structure of pchars which are the arguments specified
|
|
in the string S. Especially useful for creating an ArgV for Exec-calls
|
|
}
|
|
|
|
begin
|
|
StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
|
|
end;
|
|
|
|
Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
|
|
|
|
var
|
|
i,nr : longint;
|
|
Buf : ^char;
|
|
p : ppchar;
|
|
|
|
begin
|
|
buf:=s;
|
|
nr:=1;
|
|
while (buf^<>#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.
|