Browse Source

--- Merging r18093 into '.':
U rtl/objpas/sysutils/dati.inc
U rtl/objpas/sysutils/datih.inc
--- Merging r18100 into '.':
G rtl/objpas/sysutils/dati.inc
G rtl/objpas/sysutils/datih.inc
--- Merging r18105 into '.':
U packages/fcl-process/src/process.pp
--- Merging r18110 into '.':
G rtl/objpas/sysutils/dati.inc
G rtl/objpas/sysutils/datih.inc
--- Merging r18131 into '.':
U rtl/win/sysos.inc
--- Merging r18134 into '.':
U rtl/objpas/math.pp
--- Merging r18158 into '.':
U packages/fcl-extra/src/daemonapp.pp
--- Merging r18174 into '.':
U rtl/objpas/types.pp
--- Merging r18178 into '.':
U packages/fcl-registry/src/xregreg.inc

# revisions: 18093,18100,18105,18110,18131,18134,18158,18174,18178
------------------------------------------------------------------------
r18093 | marco | 2011-08-04 19:01:34 +0200 (Thu, 04 Aug 2011) | 2 lines
Changed paths:
M /trunk/rtl/objpas/sysutils/dati.inc
M /trunk/rtl/objpas/sysutils/datih.inc

* add overloaded strtotime, patch by Lacak2, Mantis #19870

------------------------------------------------------------------------
------------------------------------------------------------------------
r18100 | marco | 2011-08-05 15:37:16 +0200 (Fri, 05 Aug 2011) | 3 lines
Changed paths:
M /trunk/rtl/objpas/sysutils/dati.inc
M /trunk/rtl/objpas/sysutils/datih.inc

* strtodatetime adapted to new strtotime regime. Take separator from formatsettings.
Second patch fo Mantis #19870

------------------------------------------------------------------------
------------------------------------------------------------------------
r18105 | marco | 2011-08-06 00:17:30 +0200 (Sat, 06 Aug 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-process/src/process.pp

* TProcess.setparameter assigned a TStrings instead of .assign()ing it.
Patch from Cyrax, Mantis #19906

------------------------------------------------------------------------
------------------------------------------------------------------------
r18110 | marco | 2011-08-06 14:19:44 +0200 (Sat, 06 Aug 2011) | 3 lines
Changed paths:
M /trunk/rtl/objpas/sysutils/dati.inc
M /trunk/rtl/objpas/sysutils/datih.inc

* removed exporting a non standard strtotime, which was a workaround for missing
formatsettings/locale versions. Patch by Lacak2, Mantis #19870 (3rd)

------------------------------------------------------------------------
------------------------------------------------------------------------
r18131 | florian | 2011-08-07 11:15:42 +0200 (Sun, 07 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/win/sysos.inc

* convert disk full to run time error 101
------------------------------------------------------------------------
------------------------------------------------------------------------
r18134 | jonas | 2011-08-07 12:10:51 +0200 (Sun, 07 Aug 2011) | 2 lines
Changed paths:
M /trunk/rtl/objpas/math.pp

* comment and formatting fixes by Christian Budde (mantis #19919)

------------------------------------------------------------------------
------------------------------------------------------------------------
r18158 | joost | 2011-08-10 14:31:00 +0200 (Wed, 10 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-extra/src/daemonapp.pp

* Do not make the logger active in the getter, so that the application is able to change the log-type.
------------------------------------------------------------------------
------------------------------------------------------------------------
r18174 | florian | 2011-08-11 22:53:59 +0200 (Thu, 11 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/types.pp

* inline Types.Point(...)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18178 | sergei | 2011-08-12 12:43:12 +0200 (Fri, 12 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-registry/src/xregreg.inc

* Fixed undefined return value of SysGetData function. Also don't ignore the input BufSize parameter but pass it on to GetValueData. Bug #19962.
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@18827 -

marco 14 years ago
parent
commit
d2fcf6cd77

+ 0 - 1
packages/fcl-extra/src/daemonapp.pp

@@ -920,7 +920,6 @@ begin
     FEventLog:=TEventlog.Create(Self);
     FEventLog.RaiseExceptionOnError:=False;
     FEventLog.RegisterMessageFile('');
-    FEventLog.Active:=True;
     end;
   result := FEventLog;
 end;

+ 1 - 2
packages/fcl-process/src/process.pp

@@ -395,8 +395,7 @@ end;
 
 procedure TProcess.SetParameters(const AValue: TStrings);
 begin
-  if FParameters=AValue then exit;
-  FParameters:=AValue;
+  FParameters.Assign(AValue);
 end;
 
 Procedure TProcess.SetWindowRect (Value : Trect);

+ 2 - 3
packages/fcl-registry/src/xregreg.inc

@@ -47,10 +47,9 @@ function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
 
 Var
   DataType : TDataType;
-  BS : Integer;
-
 begin
-  If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,BS) then
+  Result:=BufSize;
+  If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then
     begin
     Case DataType of
       dtUnknown : RegData:=rdUnknown;

+ 7 - 7
rtl/objpas/math.pp

@@ -2365,8 +2365,8 @@ begin
 end;
 
 // dilemma here. asm can do the two comparisons in one go?
-// but pascal is portable and can be i inline;ed. Ah well, we need purepascal's anyway:
-function CompareValue ( const A, B  : Integer) : TValueRelationship;
+// but pascal is portable and can be inlined. Ah well, we need purepascal's anyway:
+function CompareValue(const A, B  : Integer): TValueRelationship;
 
 begin
   result:=GreaterThanValue;
@@ -2377,7 +2377,7 @@ begin
      result:=LessThanValue;
 end;
 
-function CompareValue ( const A, B  : Int64) : TValueRelationship;
+function CompareValue(const A, B: Int64): TValueRelationship;
 
 begin
   result:=GreaterThanValue;
@@ -2388,7 +2388,7 @@ begin
      result:=LessThanValue;
 end;
 
-function CompareValue ( const A, B : QWord) : TValueRelationship;
+function CompareValue(const A, B: QWord): TValueRelationship;
 
 begin
   result:=GreaterThanValue;
@@ -2400,7 +2400,7 @@ begin
 end;
 
 {$ifdef FPC_HAS_TYPE_SINGLE}
-function CompareValue ( const A, B : Single; delta : Single = 0.0) : TValueRelationship;
+function CompareValue(const A, B: Single; delta: Single = 0.0): TValueRelationship;
 begin
   result:=GreaterThanValue;
   if abs(a-b)<=delta then
@@ -2412,7 +2412,7 @@ end;
 {$endif}
 
 {$ifdef FPC_HAS_TYPE_DOUBLE}
-function CompareValue ( const A, B : Double; delta : Double = 0.0) : TValueRelationship;
+function CompareValue(const A, B: Double; delta: Double = 0.0): TValueRelationship;
 begin
   result:=GreaterThanValue;
   if abs(a-b)<=delta then
@@ -2424,7 +2424,7 @@ end;
 {$endif}
 
 {$ifdef FPC_HAS_TYPE_EXTENDED}
-function CompareValue ( const A, B : Extended; delta : Extended = 0.0) : TValueRelationship;
+function CompareValue (const A, B: Extended; delta: Extended = 0.0): TValueRelationship;
 begin
   result:=GreaterThanValue;
   if abs(a-b)<=delta then

+ 21 - 12
rtl/objpas/sysutils/dati.inc

@@ -708,6 +708,15 @@ begin
     Raise EConvertError.Create(Msg);
 end;
 
+function StrToTime(const S: string; FormatSettings : TFormatSettings): TDateTime;
+Var
+  Msg : AnsiString;
+begin
+  Result:=IntStrToTime(Msg, @S[1], length(S), FormatSettings, #0);
+  If (Msg<>'') then
+    Raise EConvertError.Create(Msg);
+end;
+
 function StrToTime(const s: ShortString; separator : char): TDateTime;
 begin
    result := StrToTime(@s[1], length(s), separator);
@@ -750,42 +759,42 @@ begin
     Result:=StrToDate(S);
 end;
 
-function StrToDateTime(const s: AnsiString; const UseFormat : TFormatSettings): TDateTime;
+function StrToDateTime(const s: AnsiString; const FormatSettings : TFormatSettings): TDateTime;
 var
   I: integer;
 begin
-  I:=Pos(UseFormat.TimeSeparator,S);
+  I:=Pos(FormatSettings.TimeSeparator,S);
   If (I>0) then
     begin
     While (I>0) and (S[I]<>' ') do
       Dec(I);
     If I>0 then
-      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),UseFormat.ShortDateFormat,UseFormat.DateSeparator),
-                              StrToTime(Copy(S,i+1, Length(S)-i),UseFormat.TimeSeparator))
+      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),FormatSettings.ShortDateFormat,FormatSettings.DateSeparator),
+                              StrToTime(Copy(S,i+1, Length(S)-i),FormatSettings))
     else
-      result:=StrToTime(S,UseFormat.TimeSeparator)
+      result:=StrToTime(S,FormatSettings)
     end
   else
-    Result:=StrToDate(S,UseFormat.ShortDateFormat,UseFormat.DateSeparator);
+    Result:=StrToDate(S,FormatSettings.ShortDateFormat,FormatSettings.DateSeparator);
 end;
 
-function StrToDateTime(const s: ShortString; const UseFormat : TFormatSettings): TDateTime;
+function StrToDateTime(const s: ShortString; const FormatSettings : TFormatSettings): TDateTime;
 var
   I: integer;
 begin
-  I:=Pos(UseFormat.TimeSeparator,S);
+  I:=Pos(FormatSettings.TimeSeparator,S);
   If (I>0) then
     begin
     While (I>0) and (S[I]<>' ') do
       Dec(I);
     If I>0 then
-      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),UseFormat.ShortDateFormat,UseFormat.DateSeparator),
-                              StrToTime(Copy(S,i+1, Length(S)-i),UseFormat.TimeSeparator))
+      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),FormatSettings.ShortDateFormat,FormatSettings.DateSeparator),
+                              StrToTime(Copy(S,i+1, Length(S)-i),FormatSettings.TimeSeparator))
     else
-      result:=StrToTime(S,UseFormat.TimeSeparator)
+      result:=StrToTime(S,FormatSettings.TimeSeparator)
     end
   else
-    Result:=StrToDate(S,UseFormat.ShortDateFormat,UseFormat.DateSeparator);
+    Result:=StrToDate(S,FormatSettings.ShortDateFormat,FormatSettings.DateSeparator);
 end;
 
 {   FormatDateTime formats DateTime to the given format string FormatStr   }

+ 3 - 2
rtl/objpas/sysutils/datih.inc

@@ -135,13 +135,14 @@ function StrToTime(const S: Shortstring): TDateTime;                  {$ifdef SY
 function StrToTime(const S: Ansistring): TDateTime;                   {$ifdef SYSUTILSINLINE}inline;{$endif}
 function StrToTime(const S: ShortString; separator : char): TDateTime;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function StrToTime(const S: AnsiString; separator : char): TDateTime; {$ifdef SYSUTILSINLINE}inline;{$endif}
+function StrToTime(const S: string; FormatSettings : TFormatSettings): TDateTime;
 function StrToDate(const S: ShortString; const useformat : string; separator : char): TDateTime;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function StrToDate(const S: AnsiString; const useformat : string; separator : char): TDateTime;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function StrToTime(const S: PChar; Len : integer; separator : char = #0): TDateTime;
 function StrToDate(const S: PChar; Len : integer; const useformat : string; separator : char = #0): TDateTime;
 function StrToDateTime(const S: string): TDateTime;
-function StrToDateTime(const s: ShortString; const UseFormat : TFormatSettings): TDateTime;
-function StrToDateTime(const s: AnsiString; const UseFormat : TFormatSettings): TDateTime;
+function StrToDateTime(const s: ShortString; const FormatSettings : TFormatSettings): TDateTime;
+function StrToDateTime(const s: AnsiString; const FormatSettings : TFormatSettings): TDateTime;
 function FormatDateTime(const FormatStr: string; DateTime: TDateTime):string;
 function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings): string;
 procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime);

+ 7 - 7
rtl/objpas/types.pp

@@ -149,7 +149,7 @@ const
 
   STATFLAG_DEFAULT   	      = 0;
   STATFLAG_NONAME    	      = 1;
-  STATFLAG_NOOPEN    	      = 2; 
+  STATFLAG_NOOPEN    	      = 2;
 
 {$ifndef Wince}
   // in Wince these are in unit windows. Under 32/64 in ActiveX.
@@ -253,8 +253,8 @@ type
   TStatStg = tagSTATSTG;
   STATSTG = TStatStg;
   PStatStg = ^TStatStg;
-  
-  { classes depends on these interfaces, we can't use the activex unit in classes though }  
+
+  { classes depends on these interfaces, we can't use the activex unit in classes though }
   IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
      Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
      Function LockServer(fLock : LongBool) : HResult;StdCall;
@@ -265,7 +265,7 @@ type
      function Read(pv : Pointer;cb : DWORD;pcbRead : PDWORD) : HRESULT;stdcall;
      function Write(pv : Pointer;cb : DWORD;pcbWritten : PDWORD): HRESULT;stdcall;
   end;
-  
+
   IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
      function Seek(dlibMove : LargeInt; dwOrigin : Longint;
        out libNewPosition : LargeInt) : HResult;stdcall;
@@ -285,7 +285,7 @@ type
 function EqualRect(const r1,r2 : TRect) : Boolean;
 function Rect(Left,Top,Right,Bottom : Integer) : TRect;
 function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;
-function Point(x,y : Integer) : TPoint;
+function Point(x,y : Integer) : TPoint; inline;
 function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
 function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
 function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
@@ -326,7 +326,7 @@ begin
 end;
 
 
-function Point(x,y : Integer) : TPoint;
+function Point(x,y : Integer) : TPoint; inline;
 
 begin
   Point.x:=x;
@@ -395,7 +395,7 @@ begin
   begin
     Rect:=lRect;
     UnionRect:=true;
-  end;  
+  end;
 end;
 
 function IsRectEmpty(const Rect : TRect) : Boolean;

+ 3 - 0
rtl/win/sysos.inc

@@ -102,6 +102,7 @@ const
 {   A pipe has been closed on the other end }
 {   Removing that error allows eof to works as on other OSes }
     ERROR_BROKEN_PIPE = 109;
+    ERROR_DISK_FULL = 112;
     ERROR_DIR_NOT_EMPTY = 145;
     ERROR_ALREADY_EXISTS = 183;
 
@@ -282,6 +283,8 @@ threadvar
            { to the DOS/TP compatible error codes when in this range }
            res := word(pErrno^)+131;
          end;
+       ERROR_DISK_FULL :
+         res := 101;
        ERROR_DIR_NOT_EMPTY,
        ERROR_ALREADY_EXISTS,
        ERROR_SHARING_VIOLATION :