* Merging revisions 41951,41954,41958,r41961 from trunk:

    ------------------------------------------------------------------------
    r41951 | michael | 2019-04-28 11:02:41 +0200 (Sun, 28 Apr 2019) | 1 line
    
    * Patch from Ondrej Pokorny to fix bug ID : #32961 reflect system code page change in TEncoding
    ------------------------------------------------------------------------
    r41954 | michael | 2019-04-28 13:47:49 +0200 (Sun, 28 Apr 2019) | 1 line
    
    * Added ISO8601ToDate and inverse (Bug ID 35307)
    ------------------------------------------------------------------------
    r41958 | michael | 2019-04-28 19:15:35 +0200 (Sun, 28 Apr 2019) | 1 line
    
    * Avoid  ScanDateTime in TryISO functions, it raises an exception
    ------------------------------------------------------------------------
    r41961 | michael | 2019-04-30 07:53:38 +0200 (Tue, 30 Apr 2019) | 1 line
    
     * Fix compilation on 16-bit targets
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@42421 -

packages/rtl-objpas/src/inc/dateutil.inc

@@ -440,6 +440,24 @@ Function LocalTimeToUniversal(LT: TDateTime; TZOffset: Integer): TDateTime;
 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;
 
+// ISO date/time
+// YYYYMMDD or YYYY-MM-DD
+function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
+// HH HH:NN HH:NN:SS HH:NN:SS.ZZZ or HHNN HHNNSS HHNNSS.ZZZ
+function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
+// Combination of previous
+function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
+// Z +hh:nn -hh:nn
+Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
+
+// ISO 8601 Date/Time formatting
+
+function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
+Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
+Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
+Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
+
+
 implementation
 
 uses sysconst;
@@ -2678,6 +2696,246 @@ begin
     Result := LT;
 end;
 
+Const
+  FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
+  FmtUTCTZ = 'hh":"mm';
+
+function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
+
+const
+  FmtOffset: string = '%.02d:%.02d';
+  Sign: array[Boolean] of Char = ('+', '-');
+
+var
+  Offset: Integer;
+begin
+  Result := FormatDateTime(FmtUTC, ADate);
+  Offset := GetLocalTimeOffset;
+  if AInputIsUTC or (Offset=0) then
+    Result:=Result+'Z'
+  else
+    begin
+    Result:=Result+Sign[Offset>0];
+    Offset := Abs(Offset);
+    Result:= Result+Format(FmtOffset, [Offset div MinsPerHour, Offset mod MinsPerHour]);
+    end;
+end;
+
+function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
+var
+  xYear, xMonth, xDay: LongInt;
+begin
+  case Length(aString) of
+    8: Result :=
+          TryStrToInt(Copy(aString, 1, 4), xYear) and
+          TryStrToInt(Copy(aString, 5, 2), xMonth) and
+          TryStrToInt(Copy(aString, 7, 2), xDay) and
+          TryEncodeDate(xYear, xMonth, xDay, outDate);
+    10: Result :=
+          TryStrToInt(Copy(aString, 1, 4), xYear) and
+          TryStrToInt(Copy(aString, 6, 2), xMonth) and
+          TryStrToInt(Copy(aString, 9, 2), xDay) and
+          TryEncodeDate(xYear, xMonth, xDay, outDate);
+  else
+    Result := False;
+  end;
+  if not Result then
+    outDate := 0;
+end;
+
+
+function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
+var
+  xHour, xMinute, xSecond, xMillisecond, xLength: LongInt;
+begin
+  Result := True;
+  xLength := Length(aString);
+  if (xLength>0) and (aString[xLength] = 'Z') then
+  begin
+    Dec(xLength);
+  end else
+  if (xLength>6) and CharInSet(aString[xLength-5], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-4, 2), xHour) and
+      (aString[xLength-2] = ':') and
+      TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
+    Dec(xLength, 6);
+  end else
+  if (xLength>5) and CharInSet(aString[xLength-4], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-3, 2), xHour) and
+      TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
+    Dec(xLength, 5);
+  end else
+  if (xLength>3) and CharInSet(aString[xLength-2], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-1, 2), xHour);
+    Dec(xLength, 3);
+  end;
+  if not Result then
+  begin
+    outTime := 0;
+    Exit;
+  end;
+
+  case xLength of
+    2: Result :=
+          TryStrToInt(aString, xHour) and
+          TryEncodeTime(xHour, 0, 0, 0, outTime);
+    4: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryEncodeTime(xHour, xMinute, 0, 0, outTime);
+    5: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          TryEncodeTime(xHour, xMinute, 0, 0, outTime);
+    6: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryStrToInt(Copy(aString, 5, 2), xSecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
+    8: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          (aString[6] = ':') and
+          TryStrToInt(Copy(aString, 7, 2), xSecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
+    10: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryStrToInt(Copy(aString, 5, 2), xSecond) and
+          (aString[7] = '.') and
+          TryStrToInt(Copy(aString, 8, 3), xMillisecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
+    12: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          (aString[6] = ':') and
+          TryStrToInt(Copy(aString, 7, 2), xSecond) and
+          (aString[9] = '.') and
+          TryStrToInt(Copy(aString, 10, 3), xMillisecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
+  else
+    Result := False;
+  end;
+
+  if not Result then
+    outTime := 0;
+end;
+
+function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
+var
+  xLength: Integer;
+  sDate,sTime : String;
+  xDate, xTime: TDateTime;
+
+begin
+  xLength := Length(aString);
+  if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then
+    begin
+    sDate:=Copy(aString, 1, 10);
+    sTime:=Copy(aString, 12, Length(aString))
+    end
+  else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then
+    begin
+    sDate:=Copy(aString, 1, 8);
+    sTime:=Copy(aString, 10, Length(aString));
+    end
+  else
+    exit(False);
+  Result:=TryISOStrToDate(sDate, xDate)  and TryISOStrToTime(sTime, xTime);
+  if Result then
+    outDateTime := xDate+xTime
+  else
+    outDateTime := 0;
+end;
+
+Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
+
+Var
+  H,M : LongInt;
+
+begin
+  Result:=(TZ='Z') or (TZ='');
+  if Result then
+    TZOffset:=0
+  else
+    begin
+    Result:=TZ[1] in ['+','-'];
+    if Not Result then
+      Exit;
+    Result:=TryStrToInt(Copy(TZ,2,2),H) and TryStrToInt(Copy(TZ,5,2),M);
+    if not Result then
+      exit;
+    TZOffset:=H*60+M;
+    if (TZ[1]='+') then
+      TZOffset:=-TZOffset;
+    end;
+end;
+
+Function ISOTZStrToTZOffset(TZ : String) : Integer;
+
+begin
+  if not TryISOTZStrToTZOffSet(TZ,Result) then
+    Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
+end;
+
+Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
+
+
+Var
+  S,TZ : String;
+  L,Offset,TZOffset : Integer;
+
+begin
+  S:=DateString;
+  L:=Length(S);
+  if L=0 then
+    exit(False);
+  if S[L]='Z' then
+    begin
+    TZ:='Z';
+    S:=Copy(S,1,L-1);
+    end
+  else If (L>5) and (S[L-5] in ['+','-']) then
+    begin
+    TZ:=Copy(S,L-5,6);
+    S:=Copy(S,1,L-6);
+    end;
+  Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
+  if not Result then
+    exit;
+  aDateTime:=IncMinute(aDateTime,TZOffSet);
+  // offset for UTC or not
+  if ReturnUTC then
+    Offset:=0
+  else
+    OffSet:=-GetLocalTimeOffset;
+  aDateTime:=IncMinute(aDateTime,Offset);
+  Result:=True;
+end;
+
+Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
+
+begin
+  if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
+    Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[DateString]);
+end;
+
+Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
+
+begin
+  if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
+    Result:=aDefault;
+end;
+
 {$else}
 implementation
 {$endif FPUNONE}

rtl/objpas/sysutils/sysencoding.inc

@@ -22,7 +22,13 @@ begin
   try
 {$endif}
     if not Assigned(FStandardEncodings[seAnsi]) then
-      FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
+    begin
+      // DefaultSystemCodePage can be set to non-ANSI
+      if Assigned(widestringmanager.GetStandardCodePageProc) then
+        FStandardEncodings[seAnsi] := TMBCSEncoding.Create(widestringmanager.GetStandardCodePageProc(scpAnsi))
+      else
+        FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
+    end;
 {$ifdef FPC_HAS_FEATURE_THREADING}
   finally
     LeaveCriticalSection(FLock);
@@ -91,6 +97,40 @@ begin
   Result := GetANSI;
 end;
 
+class function TEncoding.GetSystemEncoding: TEncoding;
+var
+  I: Integer;
+begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  EnterCriticalSection(FLock);
+  try
+{$endif}
+    for I := Low(FSystemEncodings) to High(FSystemEncodings) do
+    begin
+      if FSystemEncodings[I].CodePage=DefaultSystemCodePage then
+      begin
+        Result := FSystemEncodings[I];
+        if I<>Low(FSystemEncodings) then // exchange with first position to find it faster the next time
+        begin
+          FSystemEncodings[I] := FSystemEncodings[Low(FSystemEncodings)];
+          FSystemEncodings[Low(FSystemEncodings)] := Result;
+        end;
+        Exit;
+      end;
+    end;
+    // not found - create new encoding at first position
+    Result := TMBCSEncoding.Create(DefaultSystemCodePage);
+    SetLength(FSystemEncodings, Length(FSystemEncodings)+1);
+    if High(FSystemEncodings)<>Low(FSystemEncodings) then
+      FSystemEncodings[High(FSystemEncodings)] := FSystemEncodings[Low(FSystemEncodings)];
+    FSystemEncodings[Low(FSystemEncodings)] := Result;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  finally
+    LeaveCriticalSection(FLock);
+  end;
+{$endif}
+end;
+
 class function TEncoding.GetUnicode: TEncoding;
 begin
 {$ifdef FPC_HAS_FEATURE_THREADING}
@@ -142,6 +182,7 @@ end;
 class procedure TEncoding.FreeEncodings;
 var
   E: TStandardEncoding;
+  I: Integer;
 begin
 {$ifdef FPC_HAS_FEATURE_THREADING}
   EnterCriticalSection(FLock);
@@ -149,6 +190,9 @@ begin
 {$endif}
     for E := Low(FStandardEncodings) to High(FStandardEncodings) do
       FreeAndNil(FStandardEncodings[E]);
+    for I := Low(FSystemEncodings) to High(FSystemEncodings) do
+      FSystemEncodings[I].Free;
+    SetLength(FSystemEncodings, 0);
 {$ifdef FPC_HAS_FEATURE_THREADING}
   finally
     LeaveCriticalSection(FLock);

rtl/objpas/sysutils/sysencodingh.inc

@@ -30,12 +30,14 @@ type
         seUTF8);
     var
       FStandardEncodings: array[TStandardEncoding] of TEncoding; static;
+      FSystemEncodings: array of TEncoding; static;
     Class Var
       FLock : TRTLCriticalSection;
     class function GetANSI: TEncoding; static;
     class function GetASCII: TEncoding; static;
     class function GetBigEndianUnicode: TEncoding; static;
     class function GetDefault: TEncoding; static;
+    class function GetSystemEncoding: TEncoding; static;
     class function GetUnicode: TEncoding; static;
     class function GetUTF7: TEncoding; static;
     class function GetUTF8: TEncoding; static;
@@ -99,6 +101,7 @@ type
     class property ASCII: TEncoding read GetASCII;
     class property BigEndianUnicode: TEncoding read GetBigEndianUnicode;
     class property Default: TEncoding read GetDefault;
+    class property SystemEncoding: TEncoding read GetSystemEncoding;
     class property Unicode: TEncoding read GetUnicode;
     class property UTF7: TEncoding read GetUTF7;
     class property UTF8: TEncoding read GetUTF8;