paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 18:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* (IDE-sysutils) dateutil has now unpacktime/packtime alike to Delphi dt.

Browse Source 
* newstr and disposestr for pshortstring in sysutils. Avoids import order
     problems because of duplicate definitions of pstring between objects
     and sysutils

git-svn-id: trunk@11598 -
This commit is contained in:
marco 2008-08-17 12:10:35 +00:00
parent e67c03d30a
commit 24d8341ed6
3 changed files with 68 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
rtl/objpas/dateutil.inc
View File

@ -408,6 +408,13 @@ Function DateTimeToMac(const AValue: TDateTime): Int64;
Function MacToDateTime(const AValue: Int64): TDateTime;
Function MacTimeStampToUnix(const AValue: Int64): Int64;
{ .....................................................................
Dos <-> Delphi datetime support
.....................................................................}
Function DateTimeToDosDateTime(const AValue: TDateTime): longint;
Function DosDateTimeToDateTime( AValue: longint): TDateTime;
{ ScanDateTime is a limited inverse of formatdatetime }
function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
@ -2089,6 +2096,44 @@ begin
Result:=AValue - Epoch;
end;
Function DateTimeToDosDateTime(const AValue: TDateTime): longint;
var year,month,day,hour,min,sec,msec : word;
zs : longint;
begin
decodedatetime(avalue,year,month,day,hour,min,sec,msec);
result:=-1980;
result:=result+year and 127;
result:=result shl 4;
result:=result+month;
result:=result shl 5;
result:=result+day;
result:=result shl 16;
zs:=hour;
zs:=zs shl 6;
zs:=zs+min;
zs:=zs shl 5;
zs:=zs+sec div 2;
result:=result+(zs and $ffff);
end;
Function DosDateTimeToDateTime( AValue: longint): TDateTime;
var year,month,day,hour,min,sec : integer;
begin
sec:=(AValue and 31) * 2;
avalue:=AValue shr 5;
min:=AValue and 63;
avalue:=AValue shr 6;
hour:=AValue and 31;
avalue:=AValue shr 5;
day:=AValue and 31;
avalue:=AValue shr 5;
month:=AValue and 15;
avalue:=AValue shr 4;
year:=AValue+1980;
result:=EncodeDateTime(year,month,day,hour,min,sec,0);
end;
{
Inverse of formatdatetime, destined for the dateutils unit of FPC.

19
rtl/objpas/sysutils/sysstr.inc
View File

@ -35,6 +35,19 @@ begin
end;
end;
FUNCTION NewStr (Const S: ShortString): PShortString;
VAR P: PShortString;
BEGIN
If (S = '') Then
P := Nil
Else
Begin { Return nil }
GetMem(P, Length(S) + 1); { Allocate memory }
If (P<>Nil) Then P^ := S; { Hold string }
End;
NewStr := P; { Return result }
END;
{ DisposeStr frees the memory occupied by S }
procedure DisposeStr(S: PString);
@ -46,6 +59,12 @@ begin
end;
end;
PROCEDURE DisposeStr (S: PShortString);
BEGIN
If (S <> Nil) Then FreeMem(S, Length(S^) + 1); { Release memory }
END;
{ AssignStr assigns S to P^ }
procedure AssignStr(var P: PString; const S: string);

6
rtl/objpas/sysutils/sysstrh.inc
View File

@ -67,8 +67,10 @@ Const
Var TrueBoolStrs,
FalseBoolStrs : Array of String;
function NewStr(const S: string): PString;
procedure DisposeStr(S: PString);
function NewStr(Const S: ShortString): PShortString; overload;
function NewStr(const S: string): PString; overload;
procedure DisposeStr(S: PString); overload;
procedure DisposeStr(S: PShortString); overload;
procedure AssignStr(var P: PString; const S: string);
procedure AppendStr(var Dest: String; const S: string);
function UpperCase(const s: string): string;