فهرست منبع

--- Merging r30300 into '.':
U rtl/objpas/classes/classesh.inc
U rtl/objpas/classes/stringl.inc
--- Recording mergeinfo for merge of r30300 into '.':
U .
--- Merging r30301 into '.':
G rtl/objpas/classes/stringl.inc
G rtl/objpas/classes/classesh.inc
--- Recording mergeinfo for merge of r30301 into '.':
G .
--- Merging r30302 into '.':
G rtl/objpas/classes/stringl.inc
--- Recording mergeinfo for merge of r30302 into '.':
G .
--- Merging r30367 into '.':
U rtl/objpas/classes/reader.inc
G rtl/objpas/classes/classesh.inc
U rtl/objpas/classes/writer.inc
--- Recording mergeinfo for merge of r30367 into '.':
G .
--- Merging r30368 into '.':
U rtl/unix/timezone.inc
--- Recording mergeinfo for merge of r30368 into '.':
G .
--- Merging r30628 into '.':
U packages/rtl-objpas/src/inc/dateutil.inc
--- Recording mergeinfo for merge of r30628 into '.':
G .

# revisions: 30300,30301,30302,30367,30368,30628

git-svn-id: branches/fixes_3_0@31117 -

marco 10 سال پیش
والد
کامیت
1d5749ea2b

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

@@ -2539,9 +2539,9 @@ function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
 
 begin
   if (TZOffset > 0) then
-    Result := UT - EncodeTime(TZOffset div 60, TZOffset mod 60, 0, 0)
+    Result := UT + EncodeTime(TZOffset div 60, TZOffset mod 60, 0, 0)
   else if (TZOffset < 0) then
-    Result := UT + EncodeTime(Abs(TZOffset) div 60, Abs(TZOffset) mod 60, 0, 0)
+    Result := UT - EncodeTime(Abs(TZOffset) div 60, Abs(TZOffset) mod 60, 0, 0)
   else
     Result := UT;
 end;
@@ -2556,9 +2556,9 @@ Function LocalTimeToUniversal(LT: TDateTime;TZOffset: Integer): TDateTime;
 
 begin
   if (TZOffset > 0) then
-    Result := LT + EncodeTime(TZOffset div 60, TZOffset mod 60, 0, 0)
+    Result := LT - EncodeTime(TZOffset div 60, TZOffset mod 60, 0, 0)
   else if (TZOffset < 0) then
-    Result := LT - EncodeTime(Abs(TZOffset) div 60, Abs(TZOffset) mod 60, 0, 0)
+    Result := LT + EncodeTime(Abs(TZOffset) div 60, Abs(TZOffset) mod 60, 0, 0)
   else
     Result := LT;
 end;

+ 16 - 4
rtl/objpas/classes/classesh.inc

@@ -609,6 +609,7 @@ type
     FAdapter: IStringsAdapter;
     FLBS : TTextLineBreakStyle;
     FStrictDelimiter : Boolean;
+    FLineBreak : String;
     function GetCommaText: string;
     function GetName(Index: Integer): string;
     function GetValue(const Name: string): string;
@@ -626,6 +627,8 @@ type
     Function GetDelimiter : Char;
     Function GetNameValueSeparator : Char;
     Function GetQuoteChar: Char;
+    Function GetLineBreak : String;
+    procedure SetLineBreak(const S : String);
   protected
     procedure DefineProperties(Filer: TFiler); override;
     procedure Error(const Msg: string; Data: Integer);
@@ -647,10 +650,14 @@ type
     Function GetValueFromIndex(Index: Integer): string;
     Procedure SetValueFromIndex(Index: Integer; const Value: string);
     Procedure CheckSpecialChars;
+    Class Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+    Function GetNextLinebreak (Const Value : String; Var S : String; Var P : Integer) : Boolean;
   public
     destructor Destroy; override;
-    function Add(const S: string): Integer; virtual;
-    function AddObject(const S: string; AObject: TObject): Integer; virtual;
+    function Add(const S: string): Integer; virtual; overload;
+    function AddObject(const S: string; AObject: TObject): Integer; virtual; overload;
+    function Add(const Fmt : string; const Args : Array of const): Integer; overload;
+    function AddObject(const Fmt: string; Args : Array of const; AObject: TObject): Integer; overload;
     procedure Append(const S: string);
     procedure AddStrings(TheStrings: TStrings); overload; virtual;
     procedure AddStrings(const TheStrings: array of string); overload; virtual;
@@ -682,6 +689,7 @@ type
     Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
     property Delimiter: Char read GetDelimiter write SetDelimiter;
     property DelimitedText: string read GetDelimitedText write SetDelimitedText;
+    property LineBreak : string Read GetLineBreak write SetLineBreak;
     Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter;
     property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
     Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator;
@@ -1123,6 +1131,7 @@ type
     function ReadInt32: LongInt; virtual; abstract;
     function ReadInt64: Int64; virtual; abstract;
     function ReadSet(EnumType: Pointer): Integer; virtual; abstract;
+    procedure ReadSignature; virtual; abstract;
     function ReadStr: String; virtual; abstract;
     function ReadString(StringType: TValueType): String; virtual; abstract;
     function ReadWideString: WideString;virtual;abstract;
@@ -1175,6 +1184,7 @@ type
     function ReadInt32: LongInt; override;
     function ReadInt64: Int64; override;
     function ReadSet(EnumType: Pointer): Integer; override;
+    procedure ReadSignature; override;
     function ReadStr: String; override;
     function ReadString(StringType: TValueType): String; override;
     function ReadWideString: WideString;override;
@@ -1283,6 +1293,7 @@ type
     procedure ReadListEnd;
     function ReadRootComponent(ARoot: TComponent): TComponent;
     function ReadVariant: Variant;
+    procedure ReadSignature;
     function ReadString: string;
     function ReadWideString: WideString;
     function ReadUnicodeString: UnicodeString;
@@ -1315,6 +1326,7 @@ type
     procedure BeginCollection; virtual; abstract;  { Ends with the next "EndList" }
     procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
       ChildPos: Integer); virtual; abstract;  { Ends after the second "EndList" }
+    procedure WriteSignature; virtual; abstract;
     procedure BeginList; virtual; abstract;
     procedure EndList; virtual; abstract;
     procedure BeginProperty(const PropName: String); virtual; abstract;
@@ -1351,8 +1363,6 @@ type
     FBufSize: Integer;
     FBufPos: Integer;
     FBufEnd: Integer;
-    FSignatureWritten: Boolean;
-
     procedure WriteWord(w : word); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
     procedure WriteDWord(lw : longword); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
     procedure WriteQWord(qw : qword); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
@@ -1364,6 +1374,7 @@ type
   public
     constructor Create(Stream: TStream; BufSize: Integer);
     destructor Destroy; override;
+    procedure WriteSignature; override;
 
     procedure BeginCollection; override;
     procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
@@ -1460,6 +1471,7 @@ type
     procedure WriteSet(Value: LongInt; SetType: Pointer);
     procedure WriteListBegin;
     procedure WriteListEnd;
+    Procedure WriteSignature;
     procedure WriteRootComponent(ARoot: TComponent);
     procedure WriteString(const Value: string);
     procedure WriteWideString(const Value: WideString);

+ 15 - 5
rtl/objpas/classes/reader.inc

@@ -145,13 +145,9 @@ begin
 end;
 
 procedure TBinaryObjectReader.BeginRootComponent;
-var
-  Signature: LongInt;
 begin
   { Read filer signature }
-  Read(Signature, 4);
-  if Signature <> LongInt(unaligned(FilerSignature)) then
-    raise EReadError.Create(SInvalidImage);
+  ReadSignature;
 end;
 
 procedure TBinaryObjectReader.BeginComponent(var Flags: TFilerFlags;
@@ -314,6 +310,15 @@ begin
   end;
 end;
 
+procedure TBinaryObjectReader.ReadSignature;
+var
+  Signature: LongInt;
+begin
+  Read(Signature, 4);
+  if Signature <> LongInt(unaligned(FilerSignature)) then
+    raise EReadError.Create(SInvalidImage);
+end;
+
 function TBinaryObjectReader.ReadStr: String;
 var
   i: Byte;
@@ -1021,6 +1026,11 @@ begin
     Result := ReadInt64;
 end;
 
+procedure TReader.ReadSignature;
+begin
+  FDriver.ReadSignature;
+end;
+
 function TReader.ReadSingle: Single;
 begin
   if FDriver.NextValue = vaSingle then

+ 65 - 8
rtl/objpas/classes/stringl.inc

@@ -76,6 +76,7 @@ begin
     FNameValueSeparator:='=';
     FLBS:=DefaultTextLineBreakStyle;
     FSpecialCharsInited:=true;
+    FLineBreak:=sLineBreak;
     end;
 end;
 
@@ -103,6 +104,18 @@ begin
   Result:=FDelimiter;
 end;
 
+procedure TStrings.SetLineBreak(Const S : String);
+begin
+  CheckSpecialChars;
+  FLineBreak:=S;
+end;
+
+Function TStrings.GetLineBreak : String;
+begin
+  CheckSpecialChars;
+  Result:=FLineBreak;
+end;
+
 
 procedure TStrings.SetQuoteChar(c:Char);
 begin
@@ -487,11 +500,14 @@ Var P : Pchar;
 begin
   CheckSpecialChars;
   // Determine needed place
-  Case FLBS of
-    tlbsLF   : NL:=#10;
-    tlbsCRLF : NL:=#13#10;
-    tlbsCR   : NL:=#13; 
-  end;
+  if FLineBreak<>sLineBreak then
+    NL:=FLineBreak
+  else
+    Case FLBS of
+      tlbsLF   : NL:=#10;
+      tlbsCRLF : NL:=#13#10;
+      tlbsCR   : NL:=#13;
+    end;
   L:=0;
   NLS:=Length(NL);
   For I:=0 to count-1 do
@@ -541,7 +557,7 @@ begin
   // Empty.
 end;
 
-Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+Class Function TStrings.GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
 
 Var 
   PS : PChar;
@@ -575,6 +591,28 @@ begin
   Result:=True;
 end;
 
+Function TStrings.GetNextLineBreak (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+
+Var
+  PS,PC,PP : PChar;
+  IP,L : Integer;
+
+begin
+  S:='';
+  Result:=False;
+  If ((Length(Value)-P)<=0) then
+    exit;
+  PS:=@Value[P];
+  PC:=PS;
+  PP:=AnsiStrPos(PS,PChar(FLineBreak));
+  // Stop on #0.
+  While (PC^<>#0) and (PC<>PP) do
+    Inc(PC);
+  P:=P+(PC-PS)+Length(FLineBreak);
+  SetString(S,PS,PC-PS);
+  Result:=True;
+end;
+
 Procedure TStrings.DoSetTextStr(const Value: string; DoClear : Boolean);
 
 Var
@@ -587,8 +625,14 @@ begin
     if DoClear then
       Clear;
     P:=1;
-    While GetNextLine (Value,S,P) do
-      Add(S);
+    if FLineBreak=sLineBreak then
+      begin
+      While GetNextLine (Value,S,P) do
+        Add(S)
+      end
+    else
+      While GetNextLineBreak (Value,S,P) do
+        Add(S);
   finally
     EndUpdate;
   end;
@@ -597,12 +641,14 @@ end;
 Procedure TStrings.SetTextStr(const Value: string);
 
 begin
+  CheckSpecialChars;
   DoSetTextStr(Value,True);
 end;
 
 Procedure TStrings.AddText(const S: string);
 
 begin
+  CheckSpecialChars;
   DoSetTextStr(S,False);
 end;
 
@@ -629,6 +675,11 @@ begin
   Insert (Count,S);
 end;
 
+function TStrings.Add(const Fmt : string; const Args : Array of const): Integer;
+
+begin
+  Result:=Add(Format(Fmt,Args));
+end;
 
 
 Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
@@ -638,6 +689,11 @@ begin
   Objects[result]:=AObject;
 end;
 
+function TStrings.AddObject(const Fmt: string; Args : Array of const; AObject: TObject): Integer;
+
+begin
+  Result:=AddObject(Format(Fmt,Args),AObject);
+end;
 
 
 Procedure TStrings.Append(const S: string);
@@ -695,6 +751,7 @@ begin
       FDelimiter:=S.FDelimiter;
       FNameValueSeparator:=S.FNameValueSeparator;
       FLBS:=S.FLBS;
+      FLineBreak:=S.FLineBreak;
       AddStrings(S);
     finally
       EndUpdate;

+ 13 - 6
rtl/objpas/classes/writer.inc

@@ -118,16 +118,17 @@ begin
   WriteValue(vaCollection);
 end;
 
+procedure TBinaryObjectWriter.WriteSignature;
+
+begin
+  Write(FilerSignature, SizeOf(FilerSignature));
+end;
+
 procedure TBinaryObjectWriter.BeginComponent(Component: TComponent;
   Flags: TFilerFlags; ChildPos: Integer);
 var
   Prefix: Byte;
 begin
-  if not FSignatureWritten then
-  begin
-    Write(FilerSignature, SizeOf(FilerSignature));
-    FSignatureWritten := True;
-  end;
 
   { Only write the flags if they are needed! }
   if Flags <> [] then
@@ -567,6 +568,12 @@ begin
   FLookupRoot := ARoot;
 end;
 
+procedure TWriter.WriteSignature;
+
+begin
+  FDriver.WriteSignature;
+end;
+
 procedure TWriter.WriteBinary(AWriteData: TStreamProc);
 var
   MemBuffer: TMemoryStream;
@@ -762,7 +769,7 @@ begin
   FAncestor := AAncestor;
   FRootAncestor := AAncestor;
   FLookupRoot := ARoot;
-
+  WriteSignature;
   WriteComponent(ARoot);
 end;
 

+ 11 - 6
rtl/unix/timezone.inc

@@ -35,11 +35,11 @@ var
   num_leaps,
   num_types    : longint;
 
-  transitions  : plongint;
-  type_idxs    : pbyte;
-  types        : pttinfo;
-  zone_names   : pchar;
-  leaps        : pleap;
+  transitions  : plongint = nil;
+  type_idxs    : pbyte = Nil;
+  types        : pttinfo = Nil;
+  zone_names   : pchar = Nil;
+  leaps        : pleap = Nil;
 
 function find_transition(timer:longint):pttinfo;
 var
@@ -217,7 +217,7 @@ begin
   num_transitions:=tzhead.tzh_timecnt;
   num_types:=tzhead.tzh_typecnt;
   chars:=tzhead.tzh_charcnt;
-
+  num_leaps:=tzhead.tzh_leapcnt;
   reallocmem(transitions,num_transitions*sizeof(longint));
   reallocmem(type_idxs,num_transitions);
   reallocmem(types,num_types*sizeof(tttinfo));
@@ -323,14 +323,19 @@ procedure DoneLocalTime;
 begin
   if assigned(transitions) then
    freemem(transitions);
+  transitions:=nil;
   if assigned(type_idxs) then
    freemem(type_idxs);
+  type_idxs:=nil;
   if assigned(types) then
    freemem(types);
+  types:=nil;
   if assigned(zone_names) then
    freemem(zone_names);
+  zone_names:=Nil;
   if assigned(leaps) then
    freemem(leaps);
+  leaps:=nil;
   num_transitions:=0;
   num_leaps:=0;
   num_types:=0;