Browse Source

* (IDE-sysutils) dateutil has now unpacktime/packtime alike to Delphi dt.
* 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 -

marco 17 years ago
parent
commit
24d8341ed6
3 changed files with 68 additions and 2 deletions
  1. 45 0
      rtl/objpas/dateutil.inc
  2. 19 0
      rtl/objpas/sysutils/sysstr.inc
  3. 4 2
      rtl/objpas/sysutils/sysstrh.inc

+ 45 - 0
rtl/objpas/dateutil.inc

@@ -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 - 0
rtl/objpas/sysutils/sysstr.inc

@@ -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);

+ 4 - 2
rtl/objpas/sysutils/sysstrh.inc

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