Menu
▾
▴
jcl-checkins-diff — SVN file check-in notifications with file differences included
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(20) |
May
(48) |
Jun
(8) |
Jul
(23) |
Aug
(41) |
Sep
(42) |
Oct
(22) |
Nov
(17) |
Dec
(36) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
(43) |
Feb
(42) |
Mar
(17) |
Apr
(39) |
May
(16) |
Jun
(35) |
Jul
(37) |
Aug
(47) |
Sep
(49) |
Oct
(9) |
Nov
(52) |
Dec
(37) |
| 2008 |
Jan
(48) |
Feb
(21) |
Mar
(7) |
Apr
(2) |
May
(5) |
Jun
(17) |
Jul
(17) |
Aug
(40) |
Sep
(58) |
Oct
(38) |
Nov
(19) |
Dec
(32) |
| 2009 |
Jan
(67) |
Feb
(46) |
Mar
(54) |
Apr
(34) |
May
(37) |
Jun
(52) |
Jul
(67) |
Aug
(72) |
Sep
(48) |
Oct
(35) |
Nov
(27) |
Dec
(12) |
| 2010 |
Jan
(56) |
Feb
(46) |
Mar
(19) |
Apr
(14) |
May
(21) |
Jun
(3) |
Jul
(13) |
Aug
(48) |
Sep
(34) |
Oct
(51) |
Nov
(16) |
Dec
(32) |
| 2011 |
Jan
(36) |
Feb
(14) |
Mar
(12) |
Apr
(3) |
May
(5) |
Jun
(24) |
Jul
(15) |
Aug
(30) |
Sep
(21) |
Oct
(4) |
Nov
(25) |
Dec
(23) |
| 2012 |
Jan
(45) |
Feb
(42) |
Mar
(19) |
Apr
(14) |
May
(13) |
Jun
(7) |
Jul
(3) |
Aug
(46) |
Sep
(21) |
Oct
(10) |
Nov
(2) |
Dec
|
| 2013 |
Jan
(5) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <ou...@us...> - 2009-08-10 18:10:57
|
Revision: 2942
http://jcl.svn.sourceforge.net/jcl/?rev=2942&view=rev
Author: outchy
Date: 2009-08-10 18:10:24 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
UTF-8 BOM removal.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebugSerialization.pas
trunk/jcl/source/windows/JclDebugXMLDeserializer.pas
trunk/jcl/source/windows/JclDebugXMLSerializer.pas
Modified: trunk/jcl/source/windows/JclDebugSerialization.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugSerialization.pas 2009-08-10 18:08:06 UTC (rev 2941)
+++ trunk/jcl/source/windows/JclDebugSerialization.pas 2009-08-10 18:10:24 UTC (rev 2942)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
Modified: trunk/jcl/source/windows/JclDebugXMLDeserializer.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugXMLDeserializer.pas 2009-08-10 18:08:06 UTC (rev 2941)
+++ trunk/jcl/source/windows/JclDebugXMLDeserializer.pas 2009-08-10 18:10:24 UTC (rev 2942)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
Modified: trunk/jcl/source/windows/JclDebugXMLSerializer.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugXMLSerializer.pas 2009-08-10 18:08:06 UTC (rev 2941)
+++ trunk/jcl/source/windows/JclDebugXMLSerializer.pas 2009-08-10 18:10:24 UTC (rev 2942)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 18:08:40
|
Revision: 2941
http://jcl.svn.sourceforge.net/jcl/?rev=2941&view=rev
Author: outchy
Date: 2009-08-10 18:08:06 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
missing resource file.
Added Paths:
-----------
trunk/jcl/examples/windows/debug/mttest/JclDebugMTTest.res
Added: trunk/jcl/examples/windows/debug/mttest/JclDebugMTTest.res
===================================================================
(Binary files differ)
Property changes on: trunk/jcl/examples/windows/debug/mttest/JclDebugMTTest.res
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 17:55:20
|
Revision: 2940
http://jcl.svn.sourceforge.net/jcl/?rev=2940&view=rev
Author: outchy
Date: 2009-08-10 17:54:31 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
help update to reflect latest changes in the library.
Modified Paths:
--------------
trunk/help/Base.dtx
trunk/help/Debug.dtx
trunk/help/JCLHelp.dox
trunk/help/Streams.dtx
trunk/help/Strings.dtx
trunk/jcl/source/common/JclContainerIntf.pas
trunk/jcl/source/prototypes/JclContainerIntf.pas
Modified: trunk/help/Base.dtx
===================================================================
--- trunk/help/Base.dtx 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/help/Base.dtx 2009-08-10 17:54:31 UTC (rev 2940)
@@ -342,36 +342,11 @@
TDynLongintArray array of Longint
TDynCardinalArray array of Cardinal
TDynInt64Array array of Int64
+TDynSizeIntArray array of SizeInt
TDynExtendedArray array of Extended
TDynDoubleArray array of Double
TDynSingleArray array of Single
</TABLE>
-
- Compiler does not support dynamic arrays (See the various DynArrayXxx routines).
- The TDynXxxArray types are declared as a pointer to PDynXxxArray types. The
- use of the 'P' and 'T' prefix are reversed here to maintain consistency with
- the situation where dynamic arrays are supported. As an example the full
- declaration of TDynByteArray is:
- PDynByteArray = array [0..DynByteArrayHigh] of Byte;
- TDynByteArray = ^PDynByteArray;
- Keep in mind that it is the TDynArray variant that actually use in your code
- but that in reality this is a pointer and as such must be dereferenced before
- you can access an element of the array.
-<TABLE>
-Type Declaration
------------------ --------------------------------------------
-TDynByteArray ^array [0..DynByteArrayHigh] of Byte
-TDynShortArray ^array [0..DynShortintArrayHigh] of Shortint
-TDynSmallintArray ^array [0..DynSmallintArrayHigh] of Smallint
-TDynWordArray ^array [0..DynWordArrayHigh] of Word
-TDynIntegerArray ^array [0..DynIntegerArrayHigh] of Integer
-TDynLongintArray ^array [0..DynLongintArrayHigh] of Longint
-TDynCardinalArray ^array [0..DynCardinalArrayHigh] of Cardinal
-TDynInt64Array ^array [0..DynInt64ArrayHigh] of Int64
-TDynExtendedArray ^array [0..DynExtendedArrayHigh] of Extended
-TDynDoubleArray ^array [0..DynDoubleArrayHigh] of Double
-TDynSingleArray ^array [0..DynSingleArrayHigh] of Single
-</TABLE>
Donator:
Marcel van Brakel
--------------------------------------------------------------------------------
@@ -588,7 +563,7 @@
@@JclVersionRelease
<COMBINE JclVersion>
--------------------------------------------------------------------------------
-@@MoveChar@string@Integer@string@Integer@Integer
+@@MoveChar@string@SizeInt@string@SizeInt@SizeInt
Summary:
This function copies characters from a Source string to a
destination index at different indexes. There are no checks
@@ -605,10 +580,13 @@
Result:
This function has no return value.
--------------------------------------------------------------------------------
-@@TULargeInteger
+@@TJclULargeInteger
Summary:
Redefinition of TUlargeInteger as defined in Windows.pas.
Description:
+ This type is an alias of ULARGE_INTEGER.
+@@ULARGE_INTEGER
+Description:
The ULARGE_INTEGER structure is used to specify a 64-bit
unsigned integer value.
Notes:
@@ -616,20 +594,24 @@
compiler has built-in support for 64-bit integers, use the
QuadPart member to store the 64-bit integer. Otherwise, use
the LowPart and HighPart members to store the 64-bit integer.
-@@TULargeInteger.HighPart
+@@ULARGE_INTEGER.HighPart
High-order 32 bits.
-@@TULargeInteger.LowPart
+@@ULARGE_INTEGER.LowPart
Low-order 32 bits.
-@@TULargeInteger.QuadPart
+@@ULARGE_INTEGER.QuadPart
Unsigned 64-bit integer.
--------------------------------------------------------------------------------
-@@DWORD
+@@SizeInt
Summary:
- Type for a double word (unsigned 32-bit integer).
+ Type for a signed machine-size integer.
Description:
- This type is not defined unless the code is compiled
- targeting a managed environment.
+ The SizeInt type is an alias to Integer for 32-bit executables and an alias to
+ Int64 for 64-bit executables.
--------------------------------------------------------------------------------
+@@PSizeInt
+Summary:
+ Pointer to a SizeInt value.
+--------------------------------------------------------------------------------
@@Int16
Summary:
Type for a signed 16-bit integer.
@@ -646,10 +628,6 @@
Summary:
Type for a signed 64-bit integer.
--------------------------------------------------------------------------------
-@@PBoolean
-Summary:
- Type for a pointer to a Boolean value.
---------------------------------------------------------------------------------
@@PByte
Summary:
Type for a pointer to an unsigned 8-bit integer.
@@ -670,9 +648,12 @@
Summary:
Type for pointer to a TLargeInteger value.
--------------------------------------------------------------------------------
-@@PULargeInteger
+@@PJclULargeInteger
Summary:
- Type for a pointer to a TULargeInteger value.
+ Alias of type PULARGE_INTEGER.
+@@PULARGE_INTEGER
+Summary:
+ Type for a pointer to a ULARGE_INTEGER value.
--------------------------------------------------------------------------------
@@TLargeInteger
Summary:
@@ -730,6 +711,10 @@
Summary:
Type for a dynamic array of Int64 (signed 64-bit integer).
--------------------------------------------------------------------------------
+@@TDynSizeIntArray
+Summary:
+ Type for a dynamic array of SizeInt (signed machine-size integer).
+--------------------------------------------------------------------------------
@@TDynIntegerArray
Summary:
Type for a dynamic array of Integer (signed 32-bit integer).
Modified: trunk/help/Debug.dtx
===================================================================
--- trunk/help/Debug.dtx 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/help/Debug.dtx 2009-08-10 17:54:31 UTC (rev 2940)
@@ -1652,9 +1652,9 @@
TStackFrame holds stack frame information.
Donator:
Hallvard Vassbotn
-@@TStackFrame.CallersEBP
- Callers EBP register
-@@TStackFrame.CallerAdr
+@@TStackFrame.CallerFrame
+ Callers frame register (EBP/RBP)
+@@TStackFrame.CallerAddr
Address of caller
@@PStackFrame
<GROUP Debugging.Stackinforoutines>
@@ -1668,12 +1668,12 @@
TStackInfo holds stack information.
Donator:
Hallvard Vassbotn
-@@TStackInfo.CallerAdr
+@@TStackInfo.CallerAddr
Return address (the address of the caller)
@@TStackInfo.Level
Caller level
-@@TStackInfo.CallersEBP
- EBP register of caller (only filled if the trace was not a raw stack trace)
+@@TStackInfo.CallerFrame
+ frame register (EBP/RBP) of caller (only filled if the trace was not a raw stack trace)
@@TStackInfo.DumpSize
Length of memory block between callers frame and this frame (only filled if the trace was not a raw stack trace)
@@TStackInfo.ParamSize
@@ -1753,7 +1753,7 @@
Description:
Create instantiates a stack list and immediately executes the trace.
Parameters:
- Raw - When set to False, the stack is traced by means of the EBP frame, when set to True, all DWORDs are checked for valid caller addresses.
+ Raw - When set to False, the stack is traced by means of the frame address, when set to True, all DWORDs are checked for valid caller addresses.
AIgnoreLevels - Number of callers to ignore upon tracing.
FirstCaller - If not nil, an explicit TJclStackInfoItem is added to the list, pointing to the FirstCaller.
Donator:
@@ -1797,7 +1797,7 @@
JclCreateStackList creates a list of all stack frames. The resulting TJclStackInfoList
is also stored internally and can be obtained again by calling JclLastExceptStackList.
Parameters:
- Raw - When set to False, the stack is traced by means of the EBP frame, when set to True, all DWORDs are checked for valid caller addresses.
+ Raw - When set to False, the stack is traced by means of the stack frame, when set to True, all DWORDs are checked for valid caller addresses.
AIgnoreLevels - Number of callers to ignore upon tracing.
FirstCaller - If not nil, an explicit TJclStackInfoItem is added to the list, pointing to the FirstCaller.
Result:
@@ -1892,8 +1892,8 @@
Description:
TExcFrame is an except frame. It holds a reference to the next frame (if any), the
location of the frame (which should always start with executable code) and the
- handlers EBP frame. Incase of Borland modules, it could also contain a reference to
- the object being constructed (this is the case for the implicit except frame for
+ handlers stack frame. Incase of Borland modules, it could also contain a reference
+ to the object being constructed (this is the case for the implicit except frame for
constructors) or a reference to Self of the method containing the handler.
Notes:
This type is copied from System.pas.
@@ -1903,8 +1903,8 @@
Link to next except frame or -1(!) if there is no next frame.
@@TExcFrame.Desc
Pointer to handler (non-Borland modules) or frame descriptor (Borland modules)
-@@TExcFrame.HEBP
- Value of the handlers EBP-frame
+@@TExcFrame.FramePointer
+ Value of the handlers stack frame pointer (EBP/RBP)
@@TExcFrame.ConstructedObject
Pointer to object being constructed. This is used by the compiler to allow for destruction of the object when an exception occured.
@@TExcFrame.SelfOfMethod
@@ -2006,12 +2006,13 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclExceptFrame.ExcFrame
+@@TJclExceptFrame.FrameLocation
Summary:
- Reference to the ExceptFrame on the stack.
+ Address of the ExceptFrame on the stack.
Description:
- ExcFrame is a reference to except frame on the stack. It is not wise to modify
- the memory pointed to by ExcFrame
+ FrameLocation is the address of the except frame on the stack. It is not wise
+ to modify the memory pointed to by FrameLocation, and its content may be
+ altered without notice.
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
Modified: trunk/help/JCLHelp.dox
===================================================================
--- trunk/help/JCLHelp.dox 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/help/JCLHelp.dox 2009-08-10 17:54:31 UTC (rev 2940)
@@ -1,4 +1,4 @@
-; This is a Doc-O-Matic version 6.2.0.1278 project file.
+; This is a Doc-O-Matic version 6.5.1.1382 project file.
; This file is maintained by Doc-O-Matic, do not edit manually.
[*Control*]
@@ -50703,6 +50703,11 @@
[Configurations\PDF\Flags]
Count=5
+FlagAttributeName0=
+FlagAttributeName1=
+FlagAttributeName2=
+FlagAttributeName3=
+FlagAttributeName4=
FlagImage0=indicator_new
FlagImage1=indicator_depreciated
FlagImage2=indicator_beta
@@ -50718,6 +50723,16 @@
FlagName2=beta
FlagName3=preliminary
FlagName4=CFW
+FlagSuppressOutput0=0
+FlagSuppressOutput1=0
+FlagSuppressOutput2=0
+FlagSuppressOutput3=0
+FlagSuppressOutput4=0
+FlagUseAsAttribute0=0
+FlagUseAsAttribute1=0
+FlagUseAsAttribute2=0
+FlagUseAsAttribute3=0
+FlagUseAsAttribute4=0
FlagUseAsIndicator0=1
FlagUseAsIndicator1=1
FlagUseAsIndicator2=1
@@ -136596,6 +136611,7 @@
ID29=.dproj
ID3=.h;.hpp;.hxx
ID31=.dom-snippet
+ID32=.cbproj
ID4=.pas;.inc;.int
ID5=.vb
ID6=.bpr;.bpk
@@ -136680,7 +136696,7 @@
TabExpandCount=4
TopicSeparator=@@
TrailerChars=-+~/#
-UseCodeSkip=0
+UseCodeSkip=1
UseParameterListInlineComments=1
WallCharacters="#$%&'*+-/=@[\]^_`{|}~
@@ -136696,7 +136712,7 @@
[Project File Info]
Template=
-Version=602
+Version=605
[Section\0]
Count=2
Modified: trunk/help/Streams.dtx
===================================================================
--- trunk/help/Streams.dtx 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/help/Streams.dtx 2009-08-10 17:54:31 UTC (rev 2940)
@@ -2337,10 +2337,5 @@
Donator:
Florent Ouchet
--------------------------------------------------------------------------------
-@@TSeekOrigin
-Donator:
- Florent Ouchet
---------------------------------------------------------------------------------
-
@@StreamSeek@TStream@Int64@TSeekOrigin
\ \
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/help/Strings.dtx 2009-08-10 17:54:31 UTC (rev 2940)
@@ -3136,7 +3136,7 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Add@Integer
+@@TJclTabSet.Add@SizeInt
Summary:
Adds a fixed tabulation position.
Description:
@@ -3205,7 +3205,7 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Create@Integer
+@@TJclTabSet.Create@SizeInt
Summary:
Initializes a new tab set instance with the specified tab width.
Description:
@@ -3216,7 +3216,7 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Create@array of Integer@Boolean
+@@TJclTabSet.Create@array of SizeInt@Boolean
Summary:
Initializes a new tab set instance with the specified fixed tabulation
positions and automatic tab width calculation.
@@ -3229,7 +3229,7 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Create@array of Integer@Boolean@Integer
+@@TJclTabSet.Create@array of SizeInt@Boolean@SizeInt
Summary:
Initializes a new tab set instance with the specified fixed tabulation
positions and tab width.
@@ -3244,7 +3244,7 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Delete@Integer
+@@TJclTabSet.Delete@SizeInt
Summary:
Removes a fixed tabulation position.
Description:
@@ -3299,11 +3299,11 @@
See the <LINK TJclTabSet, TJclTabSet> help for an example.
See also:
TJclTabSet
- TJclTabSet.Expand@string@Integer
+ TJclTabSet.Expand@string@SizeInt
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Expand@string@Integer
+@@TJclTabSet.Expand@string@SizeInt
Summary:
Expands tabs to spaces in the provided string.
Description:
@@ -3318,7 +3318,7 @@
(<LINK TJclTabSet.ZeroBased, zero-based> set to <c>False</c>).
The reverse operation (collapse sequences of spaces into tab characters) can
- be achieved by the <LINK TJclTabSet.Optimize@string@Integer, Optimize> method.
+ be achieved by the <LINK TJclTabSet.Optimize@string@SizeInt, Optimize> method.
Parameters:
S - The string to expand tabs in.
Column - The starting column to use when expanding the tabs.
@@ -3407,7 +3407,7 @@
InternalTabStops provides <b>nil</b>-safe access to the actual tab stops
array.
Returns:
- A TDynIntegerArray holding each individual tab position<p>
+ A TDynSizeIntArray holding each individual tab position<p>
\xA0<i>- or -</i><p>
<b>nil</b> if the method is called on a <b>nil</b>-reference
Donator:
@@ -3519,11 +3519,11 @@
See also:
TJclTabSet
TJclTabSet.OptimalFillInfo
- TJclTabSet.Optimize@string@Integer
+ TJclTabSet.Optimize@string@SizeInt
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.Optimize@string@Integer
+@@TJclTabSet.Optimize@string@SizeInt
Summary:
Expands tabs to spaces in the provided string.
Description:
@@ -3538,7 +3538,7 @@
(<LINK TJclTabSet.ZeroBased, zero-based> set to <c>False</c>).
The reverse operation (expand sequences of tab characters into spaces) can
- be achieved by the <LINK TJclTabSet.Expand@string@Integer, Expand> method.
+ be achieved by the <LINK TJclTabSet.Expand@string@SizeInt, Expand> method.
Parameters:
S - The string to expand tabs in.
Column - The starting column to use when expanding the tabs.
@@ -3662,7 +3662,7 @@
fixed positions.
Using this overload is the same as using the one with the
- <LINK TJclTabSet.ToString@Integer, formatting options>, specifying the
+ <LINK TJclTabSet.ToString@SizeInt, formatting options>, specifying the
TabSetFormatting_Full option.
The resulting string will be composed of the following items:
@@ -3688,7 +3688,7 @@
Notes:
This method is <i><b>nil</b>-safe</i>.
--------------------------------------------------------------------------------
-@@TJclTabSet.ToString@Integer
+@@TJclTabSet.ToString@SizeInt
Summary
Converts the tab set into its string representation using the specified
formatting.
@@ -3756,12 +3756,12 @@
See the <LINK TJclTabSet, TJclTabSet> help for an example.
See also:
TJclTabSet
- TJclTabSet.Expand@string@Integer
+ TJclTabSet.Expand@string@SizeInt
TJclTabSet.TabFrom
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.UpdatePosition@string@Integer
+@@TJclTabSet.UpdatePosition@string@SizeInt
Summary:
Calculates the ending column after expanding tabs in the provided
string.
@@ -3787,12 +3787,12 @@
See the <LINK TJclTabSet, TJclTabSet> help for an example.
See also:
TJclTabSet
- TJclTabSet.Expand@string@Integer
+ TJclTabSet.Expand@string@SizeInt
TJclTabSet.TabFrom
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
-@@TJclTabSet.UpdatePosition@string@Integer@Integer
+@@TJclTabSet.UpdatePosition@string@SizeInt@SizeInt
Summary:
Calculates the ending line and column after expanding tabs in the provided
string.
@@ -3822,7 +3822,7 @@
See the <LINK TJclTabSet, TJclTabSet> help for an example.
See also:
TJclTabSet
- TJclTabSet.Expand@string@Integer
+ TJclTabSet.Expand@string@SizeInt
TJclTabSet.TabFrom
Donator:
Marcel Bestebroer
@@ -3848,7 +3848,7 @@
<b>nil</b>-reference, this property will return <c>True</c>. When written to
on a <b>nil</b>-reference, a NullReferenceException will be raised.
See also:
- TJclTabSet.Expand@string@Integer
+ TJclTabSet.Expand@string@SizeInt
TJclTabSet.TabStops
TJclTabSet.TabFrom
Donator:
Modified: trunk/jcl/source/common/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/common/JclContainerIntf.pas 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/jcl/source/common/JclContainerIntf.pas 2009-08-10 17:54:31 UTC (rev 2940)
@@ -1816,6 +1816,7 @@
end;
{$IFDEF SUPPORTS_GENERICS}
+ //DOM-IGNORE-BEGIN
IJclCollection<T> = interface(IJclContainer)
['{67EE8AF3-19B0-4DCA-A730-3C9B261B8EC5}']
function Add(const AItem: T): Boolean;
@@ -1837,6 +1838,7 @@
function GetEnumerator: IJclIterator<T>;
{$ENDIF SUPPORTS_FOR_IN}
end;
+ //DOM-IGNORE-END
{$ENDIF SUPPORTS_GENERICS}
IJclIntfList = interface(IJclIntfCollection)
Modified: trunk/jcl/source/prototypes/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/prototypes/JclContainerIntf.pas 2009-08-10 17:18:50 UTC (rev 2939)
+++ trunk/jcl/source/prototypes/JclContainerIntf.pas 2009-08-10 17:54:31 UTC (rev 2940)
@@ -792,7 +792,9 @@
{$JPPEXPANDMACRO COLLECTION(IJclCollection,IJclContainer,58947EF1-CD21-4DD1-AE3D-225C3AAD7EE5,,AObject,TObject,IJclIterator)}
{$IFDEF SUPPORTS_GENERICS}
+ //DOM-IGNORE-BEGIN
{$JPPEXPANDMACRO COLLECTION(IJclCollection<T>,IJclContainer,67EE8AF3-19B0-4DCA-A730-3C9B261B8EC5,const ,AItem,T,IJclIterator<T>)}
+ //DOM-IGNORE-END
{$ENDIF SUPPORTS_GENERICS}
{$JPPEXPANDMACRO LIST(IJclIntfList,IJclIntfCollection,E14EDA4B-1DAA-4013-9E6C-CDCB365C7CF9,const ,AInterface,IInterface,GetObject,SetObject,Objects)}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 17:18:58
|
Revision: 2939
http://jcl.svn.sourceforge.net/jcl/?rev=2939&view=rev
Author: outchy
Date: 2009-08-10 17:18:50 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
style cleaning of unitversioning logpath properties.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebugSerialization.pas
trunk/jcl/source/windows/JclDebugXMLDeserializer.pas
trunk/jcl/source/windows/JclDebugXMLSerializer.pas
Modified: trunk/jcl/source/windows/JclDebugSerialization.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugSerialization.pas 2009-08-10 17:18:14 UTC (rev 2938)
+++ trunk/jcl/source/windows/JclDebugSerialization.pas 2009-08-10 17:18:50 UTC (rev 2939)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -184,7 +184,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\source\windows';
Extra: '';
Data: nil
);
Modified: trunk/jcl/source/windows/JclDebugXMLDeserializer.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugXMLDeserializer.pas 2009-08-10 17:18:14 UTC (rev 2938)
+++ trunk/jcl/source/windows/JclDebugXMLDeserializer.pas 2009-08-10 17:18:50 UTC (rev 2939)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -51,7 +51,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\source\windows';
Extra: '';
Data: nil
);
Modified: trunk/jcl/source/windows/JclDebugXMLSerializer.pas
===================================================================
--- trunk/jcl/source/windows/JclDebugXMLSerializer.pas 2009-08-10 17:18:14 UTC (rev 2938)
+++ trunk/jcl/source/windows/JclDebugXMLSerializer.pas 2009-08-10 17:18:50 UTC (rev 2939)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -51,7 +51,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\source\windows';
Extra: '';
Data: nil
);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-08-10 17:18:31
|
Revision: 2938
http://jcl.svn.sourceforge.net/jcl/?rev=2938&view=rev
Author: obones
Date: 2009-08-10 17:18:14 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
Regenerated by installer
Modified Paths:
--------------
trunk/jcl/packages/c6/JclBaseExpert.res
trunk/jcl/packages/c6/JclRepositoryExpert.res
Modified: trunk/jcl/packages/c6/JclBaseExpert.res
===================================================================
(Binary files differ)
Modified: trunk/jcl/packages/c6/JclRepositoryExpert.res
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-08-10 16:56:52
|
Revision: 2937
http://jcl.svn.sourceforge.net/jcl/?rev=2937&view=rev
Author: obones
Date: 2009-08-10 16:56:41 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
Fix the crash with D6 compiler, the casts seem to confuse it.
Modified Paths:
--------------
trunk/jcl/source/common/JclBorlandTools.pas
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2009-08-10 15:00:08 UTC (rev 2936)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2009-08-10 16:56:41 UTC (rev 2937)
@@ -2412,8 +2412,15 @@
if Assigned(FOutputCallback) then
begin
{$IFDEF MSWINDOWS}
- // Text is OEM
+ // Text is OEM under Windows
+ // Code below seems to crash older compilers at times, so we only do
+ // the casts when it's absolutely necessary, that is when compiling
+ // with a unicode compiler.
+ {$IFDEF UNICODE}
AnsiText := string(StrOemToAnsi(AnsiString(Text)));
+ {$ELSE}
+ AnsiText := StrOemToAnsi(Text);
+ {$ENDIF UNICODE}
{$ELSE ~MSWINDOWS}
AnsiText := Text;
{$ENDIF ~MSWINDOWS}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 15:00:20
|
Revision: 2936
http://jcl.svn.sourceforge.net/jcl/?rev=2936&view=rev
Author: outchy
Date: 2009-08-10 15:00:08 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
style cleaning of unitversioning logpath properties.
Modified Paths:
--------------
trunk/jcl/examples/common/unitversioning/UnitVersioningTestDLL.dpr
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPI.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPIImpl.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerClasses.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerConfigFrame.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerExceptInfoFrame.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormBDS.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormDelphi.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerModuleFrame.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerOptions.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackCodeUtils.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackFrame.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackUtils.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerThreadFrame.pas
Modified: trunk/jcl/examples/common/unitversioning/UnitVersioningTestDLL.dpr
===================================================================
--- trunk/jcl/examples/common/unitversioning/UnitVersioningTestDLL.dpr 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/examples/common/unitversioning/UnitVersioningTestDLL.dpr 2009-08-10 15:00:08 UTC (rev 2936)
@@ -37,10 +37,12 @@
const
UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$RCSfile$';
+ RCSfile: '$Url:$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\examples\common\unitversioning';
+ Extra: '';
+ Data: nil
);
begin
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPI.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPI.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPI.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -28,10 +28,16 @@
unit JclStackTraceViewerAPI;
+{$I jcl.inc}
+
interface
uses
- Classes, ActiveX, Forms;
+ Classes, ActiveX,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ Forms;
const
livLocationInfo = 1;
@@ -228,6 +234,18 @@
function RegisterRevisionProvider(const ATranslator: IJclRevisionProvider): Integer;
procedure UnregisterRevisionProvider(AIndex: Integer);
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL$';
+ Revision: '$Revision$';
+ Date: '$Date$';
+ LogPath: 'JCL\experts\stacktraceviewer';
+ Extra: '';
+ Data: nil
+ );
+{$ENDIF UNITVERSIONING}
+
implementation
function RegisterLineNumberTranslator(const ATranslator: IJclLineNumberTranslator): Integer;
@@ -250,4 +268,12 @@
UnregisterRevisionProviderProc(AIndex);
end;
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
end.
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPIImpl.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPIImpl.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerAPIImpl.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -88,7 +88,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerClasses.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerClasses.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerClasses.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -191,7 +191,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerConfigFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerConfigFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerConfigFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -59,7 +59,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerExceptInfoFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerExceptInfoFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerExceptInfoFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -61,7 +61,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -86,7 +86,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormBDS.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormBDS.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormBDS.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -77,7 +77,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormDelphi.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormDelphi.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFormDelphi.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -72,7 +72,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -103,7 +103,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerModuleFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerModuleFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerModuleFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -60,7 +60,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerOptions.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerOptions.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerOptions.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -58,7 +58,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackCodeUtils.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackCodeUtils.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackCodeUtils.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -55,7 +55,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -73,7 +73,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackUtils.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackUtils.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerStackUtils.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -75,7 +75,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerThreadFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerThreadFrame.pas 2009-08-10 13:54:58 UTC (rev 2935)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerThreadFrame.pas 2009-08-10 15:00:08 UTC (rev 2936)
@@ -85,7 +85,7 @@
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
- LogPath: '';
+ LogPath: 'JCL\experts\stacktraceviewer';
Extra: '';
Data: nil
);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 13:55:10
|
Revision: 2935
http://jcl.svn.sourceforge.net/jcl/?rev=2935&view=rev
Author: outchy
Date: 2009-08-10 13:54:58 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
The JclDebugSerialization, JclDebugXMLDeserializer and JclDebugXMLSerializer units are runtime code --> move from the JclStackTraceViewerExpert design-time package to Jcl run-time package.
Modified Paths:
--------------
trunk/jcl/packages/c6/Jcl.bpk
trunk/jcl/packages/c6/Jcl.dpk
trunk/jcl/packages/c6/JclStackTraceViewerExpert.bpk
trunk/jcl/packages/c6/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpf
trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpr
trunk/jcl/packages/d10/Jcl.dpk
trunk/jcl/packages/d10/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d10/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/d11/Jcl.dpk
trunk/jcl/packages/d11/Jcl.dproj
trunk/jcl/packages/d11/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d11/JclStackTraceViewerExpert.dproj
trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dproj
trunk/jcl/packages/d12/Jcl.dpk
trunk/jcl/packages/d12/Jcl.dproj
trunk/jcl/packages/d12/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d12/JclStackTraceViewerExpert.dproj
trunk/jcl/packages/d12/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/d12/JclStackTraceViewerExpertDLL.dproj
trunk/jcl/packages/d6/Jcl.dpk
trunk/jcl/packages/d6/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d6/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/d7/Jcl.dpk
trunk/jcl/packages/d7/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d7/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/d9/Jcl.dpk
trunk/jcl/packages/d9/JclStackTraceViewerExpert.dpk
trunk/jcl/packages/d9/JclStackTraceViewerExpertDLL.dpr
trunk/jcl/packages/fpc/Jcl.lpk
trunk/jcl/packages/fpc/Jcl.pas
trunk/jcl/packages/xml/Jcl-R.xml
trunk/jcl/packages/xml/JclStackTraceViewerExpert-D.xml
trunk/jcl/packages/xml/JclStackTraceViewerExpertDLL-L.xml
Added Paths:
-----------
trunk/jcl/source/windows/JclDebugSerialization.pas
trunk/jcl/source/windows/JclDebugXMLDeserializer.pas
trunk/jcl/source/windows/JclDebugXMLSerializer.pas
Removed Paths:
-------------
trunk/jcl/experts/stacktraceviewer/JclDebugSerialization.pas
trunk/jcl/experts/stacktraceviewer/JclDebugXMLDeserializer.pas
trunk/jcl/experts/stacktraceviewer/JclDebugXMLSerializer.pas
Deleted: trunk/jcl/experts/stacktraceviewer/JclDebugSerialization.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclDebugSerialization.pas 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/experts/stacktraceviewer/JclDebugSerialization.pas 2009-08-10 13:54:58 UTC (rev 2935)
@@ -1,759 +0,0 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) }
-{ }
-{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
-{ you may not use this file except in compliance with the License. You may obtain a copy of the }
-{ License at http://www.mozilla.org/MPL/ }
-{ }
-{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
-{ ANY KIND, either express or implied. See the License for the specific language governing rights }
-{ and limitations under the License. }
-{ }
-{ The Original Code is JclDebugSerialization.pas. }
-{ }
-{ The Initial Developer of the Original Code is Uwe Schuster. }
-{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
-{ }
-{ Contributor(s): }
-{ Uwe Schuster (uschuster) }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: $ }
-{ Revision: $Rev:: $ }
-{ Author: $Author:: $ }
-{ }
-{**************************************************************************************************}
-
-unit JclDebugSerialization;
-
-{$I jcl.inc}
-
-interface
-
-uses
- SysUtils, Classes, Contnrs,
- {$IFDEF UNITVERSIONING}
- JclUnitVersioning,
- {$ENDIF UNITVERSIONING}
- JclDebug;
-
-type
- TJclCustomSimpleSerializer = class(TObject)
- protected
- FItems: TObjectList;
- FName: string;
- FValues: TStringList;
- function GetCount: Integer;
- function GetItems(AIndex: Integer): TJclCustomSimpleSerializer;
- public
- constructor Create(const AName: string);
- destructor Destroy; override;
- function AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer;
- procedure Clear;
- function ReadString(ASender: TObject; const AName: string): string;
- procedure WriteString(ASender: TObject; const AName: string; const AValue: string);
- property Count: Integer read GetCount;
- property Items[AIndex: Integer]: TJclCustomSimpleSerializer read GetItems; default;
- property Name: string read FName;
- property Values: TStringList read FValues;
- end;
-
- TJclSerializableLocationInfo = class(TJclLocationInfoEx)
- public
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- end;
-
- TJclSerializableLocationInfoList = class(TJclCustomLocationInfoList)
- private
- function GetItems(AIndex: Integer): TJclSerializableLocationInfo;
- public
- constructor Create; override;
- function Add(Addr: Pointer): TJclSerializableLocationInfo;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property Items[AIndex: Integer]: TJclSerializableLocationInfo read GetItems; default;
- end;
-
- TJclSerializableThreadInfo = class(TJclCustomThreadInfo)
- private
- function GetStack(const AIndex: Integer): TJclSerializableLocationInfoList;
- protected
- function GetStackClass: TJclCustomLocationInfoListClass; override;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property CreationStack: TJclSerializableLocationInfoList index 1 read GetStack;
- property Stack: TJclSerializableLocationInfoList index 2 read GetStack;
- end;
-
- TJclSerializableThreadInfoList = class(TPersistent)
- private
- FItems: TObjectList;
- function GetItems(AIndex: Integer): TJclSerializableThreadInfo;
- function GetCount: Integer;
- public
- constructor Create;
- destructor Destroy; override;
- function Add: TJclSerializableThreadInfo;
- procedure Assign(Source: TPersistent); override;
- procedure Clear;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property Count: Integer read GetCount;
- property Items[AIndex: Integer]: TJclSerializableThreadInfo read GetItems; default;
- end;
-
- TJclSerializableException = class(TPersistent)
- private
- FExceptionClassName: string;
- FExceptionMessage: string;
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- procedure Clear;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property ExceptionClassName: string read FExceptionClassName write FExceptionClassName;
- property ExceptionMessage: string read FExceptionMessage write FExceptionMessage;
- end;
-
- TJclSerializableModuleInfo = class(TPersistent)
- private
- FStartStr: string;
- FEndStr: string;
- FSystemModuleStr: string;
- FModuleName: string;
- FBinFileVersion: string;
- FFileVersion: string;
- FFileDescription: string;
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property StartStr: string read FStartStr write FStartStr;
- property EndStr: string read FEndStr write FEndStr;
- property SystemModuleStr: string read FSystemModuleStr write FSystemModuleStr;
- property ModuleName: string read FModuleName write FModuleName;
- property BinFileVersion: string read FBinFileVersion write FBinFileVersion;
- property FileVersion: string read FFileVersion write FFileVersion;
- property FileDescription: string read FFileDescription write FFileDescription;
- end;
-
- TJclSerializableModuleInfoList = class(TPersistent)
- private
- FItems: TObjectList;
- function GetCount: Integer;
- function GetItems(AIndex: Integer): TJclSerializableModuleInfo;
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- constructor Create;
- destructor Destroy; override;
- function Add: TJclSerializableModuleInfo;
- procedure Clear;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property Count: Integer read GetCount;
- property Items[AIndex: Integer]: TJclSerializableModuleInfo read GetItems; default;
- end;
-
- TJclSerializableExceptionInfo = class(TObject)
- private
- FException: TJclSerializableException;
- FThreadInfoList: TJclSerializableThreadInfoList;
- FModules: TJclSerializableModuleInfoList;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
- procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
- property ThreadInfoList: TJclSerializableThreadInfoList read FThreadInfoList;
- property Exception: TJclSerializableException read FException;
- property Modules: TJclSerializableModuleInfoList read FModules;
- end;
-
-{$IFDEF UNITVERSIONING}
-const
- UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$URL$';
- Revision: '$Revision$';
- Date: '$Date$';
- LogPath: '';
- Extra: '';
- Data: nil
- );
-{$ENDIF UNITVERSIONING}
-
-implementation
-
-uses
- JclDateTime;
-
-const
- MinutesPerDay = 60 * 24;
-
-{ TODO -oUSc : move to JclDateTime }
-function ISOFormatStrToDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime;
-var
- Year, Month, Day, Hour, Minute, Second: Word;
-begin
- Result := ADefault;
- { TODO -oUSc : make it more generics to accept for exam. milliseconds }
- if (Length(AISOFormatTimeStampStr) = 25) or ((Length(AISOFormatTimeStampStr) = 20) and
- (AISOFormatTimeStampStr[20] = 'Z')) then
- begin
- if (AISOFormatTimeStampStr[5] = '-') and (AISOFormatTimeStampStr[8] = '-') and
- (AISOFormatTimeStampStr[11] = 'T') and (AISOFormatTimeStampStr[14] = ':') and
- (AISOFormatTimeStampStr[17] = ':') then
- begin
- Year := StrToInt(Copy(AISOFormatTimeStampStr, 1, 4));
- Month := StrToInt(Copy(AISOFormatTimeStampStr, 6, 2));
- Day := StrToInt(Copy(AISOFormatTimeStampStr, 9, 2));
- Hour := StrToInt(Copy(AISOFormatTimeStampStr, 12, 2));
- Minute := StrToInt(Copy(AISOFormatTimeStampStr, 15, 2));
- Second := StrToInt(Copy(AISOFormatTimeStampStr, 18, 2));
- Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Minute, Second, 0);
- end;
- end;
-end;
-
-function ISOFormatStrToLocalDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime;
-begin
- Result := ISOFormatStrToDateTime(AISOFormatTimeStampStr, ADefault);
- Result := DateTimeToLocalDateTime(Result);
-end;
-
-function DateTimeToISOFormatStr(ATimeStamp: TDateTime; ABias: Longint): string;
-var
- TimeZoneAsDateTime: TDateTime;
- S: string;
-begin
- Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', ATimeStamp);
- TimeZoneAsDateTime := ABias / MinutesPerDay;
- S := FormatDateTime('hh:nn', Abs(TimeZoneAsDateTime));
- if ABias > 0 then
- Result := Result + '+' + S
- else
- if ABias = 0 then
- Result := Result + 'Z'
- else
- Result := Result + '-' + S;
-end;
-
-function LocalDateTimeToISOFormatStr(ATimeStamp: TDateTime): string;
-var
- UTCTimeStamp, TimeZoneAsDateTime: TDateTime;
-begin
- UTCTimeStamp := LocalDateTimeToDateTime(ATimeStamp);
- TimeZoneAsDateTime := ATimeStamp - UTCTimeStamp;
- Result := DateTimeToISOFormatStr(UTCTimeStamp, Round(TimeZoneAsDateTime * MinutesPerDay));
-end;
-
-//=== { TJclCustomSimpleSerializer } =========================================
-
-constructor TJclCustomSimpleSerializer.Create(const AName: string);
-begin
- inherited Create;
- FItems := TObjectList.Create;
- FName := AName;
- FValues := TStringList.Create;
-end;
-
-destructor TJclCustomSimpleSerializer.Destroy;
-begin
- FValues.Free;
- FItems.Free;
- inherited Destroy;
-end;
-
-function TJclCustomSimpleSerializer.AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer;
-begin
- FItems.Add(TJclCustomSimpleSerializer.Create(AName));
- Result := TJclCustomSimpleSerializer(FItems.Last);
-end;
-
-procedure TJclCustomSimpleSerializer.Clear;
-begin
- FItems.Clear;
- FValues.Clear;
- FName := '';
-end;
-
-function TJclCustomSimpleSerializer.GetCount: Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TJclCustomSimpleSerializer.GetItems(AIndex: Integer): TJclCustomSimpleSerializer;
-begin
- Result := TJclCustomSimpleSerializer(FItems[AIndex]);
-end;
-
-function TJclCustomSimpleSerializer.ReadString(ASender: TObject; const AName: string): string;
-begin
- Result := FValues.Values[AName];
-end;
-
-procedure TJclCustomSimpleSerializer.WriteString(ASender: TObject; const AName: string; const AValue: string);
-begin
- FValues.Add(Format('%s=%s', [AName, AValue]));
-end;
-
-//=== { TJclSerializableThreadInfoList } =====================================
-
-constructor TJclSerializableThreadInfoList.Create;
-begin
- inherited Create;
- FItems := TObjectList.Create;
-end;
-
-destructor TJclSerializableThreadInfoList.Destroy;
-begin
- FItems.Free;
- inherited Destroy;
-end;
-
-function TJclSerializableThreadInfoList.Add: TJclSerializableThreadInfo;
-begin
- FItems.Add(TJclSerializableThreadInfo.Create);
- Result := TJclSerializableThreadInfo(FItems.Last);
-end;
-
-procedure TJclSerializableThreadInfoList.Assign(Source: TPersistent);
-var
- I: Integer;
-begin
- if Source is TJclThreadInfoList then
- begin
- Clear;
- for I := 0 to TJclThreadInfoList(Source).Count - 1 do
- Add.Assign(TJclThreadInfoList(Source)[I]);
- end
- else
- inherited Assign(Source);
-end;
-
-procedure TJclSerializableThreadInfoList.Clear;
-begin
- FItems.Clear;
-end;
-
-function TJclSerializableThreadInfoList.GetCount: Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TJclSerializableThreadInfoList.GetItems(AIndex: Integer): TJclSerializableThreadInfo;
-begin
- Result := TJclSerializableThreadInfo(FItems[AIndex]);
-end;
-
-procedure TJclSerializableThreadInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- Clear;
- for I := 0 to ASerializer.Count - 1 do
- if ASerializer[I].Name = 'ThreadInfo' then
- Add.Deserialize(ASerializer[I]);
-end;
-
-procedure TJclSerializableThreadInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- Items[I].Serialize(ASerializer.AddChild(Self, 'ThreadInfo'));
-end;
-
-//=== { TJclSerializableLocationInfo } =======================================
-
-procedure TJclSerializableLocationInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- S, SOffsetFromProcName, SLineNumberOffsetFromProcedureStart: string;
-begin
- Values := [];
- SOffsetFromProcName := ASerializer.ReadString(Self, 'OffsetFromProcName');
- if SOffsetFromProcName <> '' then
- Values := Values + [lievLocationInfo];
- SLineNumberOffsetFromProcedureStart := ASerializer.ReadString(Self, 'LineNumberOffsetFromProcedureStart');
- if SLineNumberOffsetFromProcedureStart <> '' then
- Values := Values + [lievProcedureStartLocationInfo];
- S := ASerializer.ReadString(Self, 'VAddress');
- VAddress := Pointer(StrToIntDef('$' + S, 0));
- ModuleName := ASerializer.ReadString(Self, 'ModuleName');
- S := ASerializer.ReadString(Self, 'Address');
- Address := Pointer(StrToIntDef('$' + S, 0));
- OffsetFromProcName := StrToIntDef('$' + SOffsetFromProcName, 0);
- SourceUnitName := ASerializer.ReadString(Self, 'UnitName');
- ProcedureName := ASerializer.ReadString(Self, 'ProcedureName');
- SourceName := ASerializer.ReadString(Self, 'SourceName');
- S := ASerializer.ReadString(Self, 'LineNumber');
- LineNumber := StrToIntDef(S, -1);
- S := ASerializer.ReadString(Self, 'OffsetFromLineNumber');
- OffsetFromLineNumber := StrToIntDef(S, -1);
- LineNumberOffsetFromProcedureStart := StrToIntDef(SLineNumberOffsetFromProcedureStart, -1);
- UnitVersionDateTime := ISOFormatStrToDateTime(ASerializer.ReadString(Self, 'UnitVersionDateTime'), 0);
- UnitVersionExtra := ASerializer.ReadString(Self, 'UnitVersionExtra');
- UnitVersionLogPath := ASerializer.ReadString(Self, 'UnitVersionLogPath');
- UnitVersionRCSfile := ASerializer.ReadString(Self, 'UnitVersionRCSfile');
- UnitVersionRevision := ASerializer.ReadString(Self, 'UnitVersionRevision');
-end;
-
-procedure TJclSerializableLocationInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
-var
- S: string;
-begin
- ASerializer.WriteString(Self, 'VAddress', Format('%p', [VAddress]));
- ASerializer.WriteString(Self, 'ModuleName', ModuleName);
- ASerializer.WriteString(Self, 'Address', Format('%p', [Address]));
- if lievLocationInfo in Values then
- begin
- ASerializer.WriteString(Self, 'OffsetFromProcName', Format('+ $%x', [OffsetFromProcName]));
- ASerializer.WriteString(Self, 'UnitName', SourceUnitName);
- ASerializer.WriteString(Self, 'ProcedureName', ProcedureName);
- ASerializer.WriteString(Self, 'SourceName', SourceName);
- if LineNumber > 0 then
- begin
- ASerializer.WriteString(Self, 'LineNumber', IntToStr(LineNumber));
- if OffsetFromLineNumber >= 0 then
- S := S + Format('+ $%x', [OffsetFromLineNumber])
- else
- S := S + Format('- $%x', [-OffsetFromLineNumber]);
- ASerializer.WriteString(Self, 'OffsetFromLineNumber', S);
- end;
- if lievProcedureStartLocationInfo in Values then
- ASerializer.WriteString(Self, 'LineNumberOffsetFromProcedureStart', IntToStr(LineNumberOffsetFromProcedureStart));
- end;
- if lievUnitVersionInfo in Values then
- begin
- ASerializer.WriteString(Self, 'UnitVersionDateTime', DateTimeToISOFormatStr(UnitVersionDateTime, 0));
- ASerializer.WriteString(Self, 'UnitVersionExtra', UnitVersionExtra);
- ASerializer.WriteString(Self, 'UnitVersionLogPath', UnitVersionLogPath);
- ASerializer.WriteString(Self, 'UnitVersionRCSfile', UnitVersionRCSfile);
- ASerializer.WriteString(Self, 'UnitVersionRevision', UnitVersionRevision);
- end;
-end;
-
-//=== { TJclSerializableLocationInfoList } ===================================
-
-function TJclSerializableLocationInfoList.Add(Addr: Pointer): TJclSerializableLocationInfo;
-begin
- Result := TJclSerializableLocationInfo(InternalAdd(Addr));
-end;
-
-constructor TJclSerializableLocationInfoList.Create;
-begin
- inherited Create;
- FItemClass := TJclSerializableLocationInfo;
- FOptions := [];
-end;
-
-function TJclSerializableLocationInfoList.GetItems(AIndex: Integer): TJclSerializableLocationInfo;
-begin
- Result := TJclSerializableLocationInfo(FItems[AIndex]);
-end;
-
-procedure TJclSerializableLocationInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- Clear;
- for I := 0 to ASerializer.Count - 1 do
- if ASerializer[I].Name = 'LocationInfo' then
- Add(nil).Deserialize(ASerializer[I]);
-end;
-
-procedure TJclSerializableLocationInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- Items[I].Serialize(ASerializer.AddChild(Self, 'LocationInfo'));
-end;
-
-//=== { TJclSerializableThreadInfo } =========================================
-
-constructor TJclSerializableThreadInfo.Create;
-begin
- inherited Create;
-end;
-
-destructor TJclSerializableThreadInfo.Destroy;
-begin
- inherited Destroy;
-end;
-
-function TJclSerializableThreadInfo.GetStack(const AIndex: Integer): TJclSerializableLocationInfoList;
-begin
- case AIndex of
- 1: Result := TJclSerializableLocationInfoList(FCreationStack);
- 2: Result := TJclSerializableLocationInfoList(FStack);
- else
- Result := nil;
- end;
-end;
-
-function TJclSerializableThreadInfo.GetStackClass: TJclCustomLocationInfoListClass;
-begin
- Result := TJclSerializableLocationInfoList;
-end;
-
-procedure TJclSerializableThreadInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- S: string;
- I: Integer;
-begin
- Values := [];
- S := ASerializer.ReadString(Self, 'ThreadID');
- ThreadID := StrToIntDef(S, 0);
- if ASerializer.ReadString(Self, 'MainThread') = '1' then
- Values := Values + [tioIsMainThread];
- S := ASerializer.ReadString(Self, 'Name');
- if S <> '' then
- begin
- Name := S;
- Values := Values + [tioName];
- end;
- S := ASerializer.ReadString(Self, 'CreationTime');
- if S <> '' then
- begin
- CreationTime := ISOFormatStrToLocalDateTime(S, 0);
- if CreationTime > 0 then
- Values := Values + [tioCreationTime];
- end;
- S := ASerializer.ReadString(Self, 'ParentThreadID');
- if S <> '' then
- begin
- ParentThreadID := StrToIntDef(S, 0);
- if ParentThreadID <> 0 then
- Values := Values + [tioParentThreadID];
- end;
- for I := 0 to ASerializer.Count - 1 do
- if ASerializer[I].Name = 'Stack' then
- begin
- Stack.Deserialize(ASerializer[I]);
- Values := Values + [tioStack];
- end
- else
- if ASerializer[I].Name = 'CreationStack' then
- begin
- CreationStack.Deserialize(ASerializer[I]);
- Values := Values + [tioCreationStack];
- end;
-end;
-
-procedure TJclSerializableThreadInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- ASerializer.WriteString(Self, 'ThreadID', IntToStr(ThreadID));
- if tioIsMainThread in Values then
- ASerializer.WriteString(Self, 'MainThread', '1');
- if tioName in Values then
- ASerializer.WriteString(Self, 'Name', Name);
- if tioCreationTime in Values then
- ASerializer.WriteString(Self, 'CreationTime', LocalDateTimeToISOFormatStr(CreationTime));
- if tioParentThreadID in Values then
- ASerializer.WriteString(Self, 'ParentThreadID', IntToStr(ParentThreadID));
- if tioStack in Values then
- Stack.Serialize(ASerializer.AddChild(Self, 'Stack'));
- if tioCreationStack in Values then
- CreationStack.Serialize(ASerializer.AddChild(Self, 'CreationStack'));
-end;
-
-//=== { TExceptionInfo } =====================================================
-
-constructor TJclSerializableExceptionInfo.Create;
-begin
- inherited Create;
- FException := TJclSerializableException.Create;
- FThreadInfoList := TJclSerializableThreadInfoList.Create;
- FModules := TJclSerializableModuleInfoList.Create;
-end;
-
-destructor TJclSerializableExceptionInfo.Destroy;
-begin
- FModules.Free;
- FException.Free;
- FThreadInfoList.Free;
- inherited Destroy;
-end;
-
-procedure TJclSerializableExceptionInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- FThreadInfoList.Clear;
- FException.Clear;
- FModules.Clear;
- for I := 0 to ASerializer.Count - 1 do
- if ASerializer[I].Name = 'ThreadInfo' then
- FThreadInfoList.Deserialize(ASerializer[I])
- else
- if ASerializer[I].Name = 'Exception' then
- FException.Deserialize(ASerializer[I])
- else
- if ASerializer[I].Name = 'Modules' then
- FModules.Deserialize(ASerializer[I]);
-end;
-
-procedure TJclSerializableExceptionInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- FThreadInfoList.Serialize(ASerializer.AddChild(Self, 'ThreadInfo'));
- FException.Serialize(ASerializer.AddChild(Self, 'Exception'));
- FModules.Serialize(ASerializer.AddChild(Self, 'Modules'));
-end;
-
-//=== { TException } =========================================================
-
-procedure TJclSerializableException.AssignTo(Dest: TPersistent);
-begin
- if Dest is TJclSerializableException then
- begin
- TJclSerializableException(Dest).FExceptionClassName := FExceptionClassName;
- TJclSerializableException(Dest).FExceptionMessage := FExceptionMessage;
- end
- else
- inherited AssignTo(Dest);
-end;
-
-procedure TJclSerializableException.Clear;
-begin
- FExceptionClassName := '';
- FExceptionMessage := '';
-end;
-
-procedure TJclSerializableException.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- Clear;
- FExceptionClassName := ASerializer.ReadString(Self, 'ClassName');
- FExceptionMessage := ASerializer.ReadString(Self, 'Message');
-end;
-
-procedure TJclSerializableException.Serialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- ASerializer.WriteString(Self, 'ClassName', FExceptionClassName);
- ASerializer.WriteString(Self, 'Message', FExceptionMessage);
-end;
-
-//=== { TModule } ============================================================
-
-procedure TJclSerializableModuleInfo.AssignTo(Dest: TPersistent);
-begin
- if Dest is TJclSerializableModuleInfo then
- begin
- TJclSerializableModuleInfo(Dest).FStartStr := FStartStr;
- TJclSerializableModuleInfo(Dest).FEndStr := FEndStr;
- TJclSerializableModuleInfo(Dest).FSystemModuleStr := FSystemModuleStr;
- TJclSerializableModuleInfo(Dest).FModuleName := FModuleName;
- TJclSerializableModuleInfo(Dest).FBinFileVersion := FBinFileVersion;
- TJclSerializableModuleInfo(Dest).FFileVersion := FFileVersion;
- TJclSerializableModuleInfo(Dest).FFileDescription := FFileDescription;
- end
- else
- inherited AssignTo(Dest);
-end;
-
-procedure TJclSerializableModuleInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- FStartStr := ASerializer.ReadString(Self, 'StartAddr');
- FEndStr := ASerializer.ReadString(Self, 'EndAddr');
- FSystemModuleStr := ASerializer.ReadString(Self, 'SystemModule');
- FModuleName := ASerializer.ReadString(Self, 'FileName');
- FBinFileVersion := ASerializer.ReadString(Self, 'BinFileVersion');
- FFileVersion := ASerializer.ReadString(Self, 'FileVersion');
- FFileDescription := ASerializer.ReadString(Self, 'FileDescription');
-end;
-
-procedure TJclSerializableModuleInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
-begin
- ASerializer.WriteString(Self, 'StartAddr', FStartStr);
- ASerializer.WriteString(Self, 'EndAddr', FEndStr);
- ASerializer.WriteString(Self, 'SystemModule', FSystemModuleStr);
- ASerializer.WriteString(Self, 'FileName', FModuleName);
- ASerializer.WriteString(Self, 'BinFileVersion', FBinFileVersion);
- ASerializer.WriteString(Self, 'FileVersion', FFileVersion);
- ASerializer.WriteString(Self, 'FileDescription', FFileDescription);
-end;
-
-//=== { TModuleList } ========================================================
-
-constructor TJclSerializableModuleInfoList.Create;
-begin
- inherited Create;
- FItems := TObjectList.Create;
-end;
-
-destructor TJclSerializableModuleInfoList.Destroy;
-begin
- FItems.Free;
- inherited Destroy;
-end;
-
-function TJclSerializableModuleInfoList.Add: TJclSerializableModuleInfo;
-begin
- FItems.Add(TJclSerializableModuleInfo.Create);
- Result := TJclSerializableModuleInfo(FItems.Last);
-end;
-
-procedure TJclSerializableModuleInfoList.AssignTo(Dest: TPersistent);
-var
- I: Integer;
-begin
- if Dest is TJclSerializableModuleInfoList then
- begin
- TJclSerializableModuleInfoList(Dest).Clear;
- for I := 0 to Count - 1 do
- TJclSerializableModuleInfoList(Dest).Add.Assign(TJclSerializableModuleInfo(FItems[I]));
- end
- else
- inherited AssignTo(Dest);
-end;
-
-procedure TJclSerializableModuleInfoList.Clear;
-begin
- FItems.Clear;
-end;
-
-function TJclSerializableModuleInfoList.GetCount: Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TJclSerializableModuleInfoList.GetItems(AIndex: Integer): TJclSerializableModuleInfo;
-begin
- Result := TJclSerializableModuleInfo(FItems[AIndex]);
-end;
-
-procedure TJclSerializableModuleInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- Clear;
- for I := 0 to ASerializer.Count - 1 do
- if ASerializer[I].Name = 'Module' then
- Add.Deserialize(ASerializer[I]);
-end;
-
-procedure TJclSerializableModuleInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- Items[I].Serialize(ASerializer.AddChild(Self, 'Module'));
-end;
-
-{$IFDEF UNITVERSIONING}
-initialization
- RegisterUnitVersion(HInstance, UnitVersioning);
-
-finalization
- UnregisterUnitVersion(HInstance);
-{$ENDIF UNITVERSIONING}
-
-end.
Deleted: trunk/jcl/experts/stacktraceviewer/JclDebugXMLDeserializer.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclDebugXMLDeserializer.pas 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/experts/stacktraceviewer/JclDebugXMLDeserializer.pas 2009-08-10 13:54:58 UTC (rev 2935)
@@ -1,97 +0,0 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) }
-{ }
-{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
-{ you may not use this file except in compliance with the License. You may obtain a copy of the }
-{ License at http://www.mozilla.org/MPL/ }
-{ }
-{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
-{ ANY KIND, either express or implied. See the License for the specific language governing rights }
-{ and limitations under the License. }
-{ }
-{ The Original Code is JclDebugXMLDeserializer.pas. }
-{ }
-{ The Initial Developer of the Original Code is Uwe Schuster. }
-{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
-{ }
-{ Contributor(s): }
-{ Uwe Schuster (uschuster) }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: $ }
-{ Revision: $Rev:: $ }
-{ Author: $Author:: $ }
-{ }
-{**************************************************************************************************}
-
-unit JclDebugXMLDeserializer;
-
-{$I jcl.inc}
-
-interface
-
-uses
- SysUtils,
- {$IFDEF UNITVERSIONING}
- JclUnitVersioning,
- {$ENDIF UNITVERSIONING}
- JclDebugSerialization, JclSimpleXml;
-
-type
- TJclXMLDeserializer = class(TJclCustomSimpleSerializer)
- public
- procedure LoadFromString(const AValue: string);
- end;
-
-{$IFDEF UNITVERSIONING}
-const
- UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$URL$';
- Revision: '$Revision$';
- Date: '$Date$';
- LogPath: '';
- Extra: '';
- Data: nil
- );
-{$ENDIF UNITVERSIONING}
-
-implementation
-
-//=== { TJclXMLDeserializer } ================================================
-
-procedure TJclXMLDeserializer.LoadFromString(const AValue: string);
-
- procedure AddItems(ASerializer: TJclCustomSimpleSerializer; AElem: TJclSimpleXMLElem);
- var
- I: Integer;
- begin
- for I := 0 to AElem.Properties.Count - 1 do
- ASerializer.Values.Add(Format('%s=%s', [AElem.Properties[I].Name, AElem.Properties[I].Value]));
- for I := 0 to AElem.Items.Count - 1 do
- AddItems(ASerializer.AddChild(nil, AElem.Items[I].Name), AElem.Items[I])
- end;
-
-var
- XML: TJclSimpleXML;
-begin
- XML := TJclSimpleXML.Create;
- try
- XML.LoadFromString(AValue);
- Clear;
- AddItems(Self, XML.Root);
- finally
- XML.Free;
- end;
-end;
-
-{$IFDEF UNITVERSIONING}
-initialization
- RegisterUnitVersion(HInstance, UnitVersioning);
-
-finalization
- UnregisterUnitVersion(HInstance);
-{$ENDIF UNITVERSIONING}
-
-end.
Deleted: trunk/jcl/experts/stacktraceviewer/JclDebugXMLSerializer.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclDebugXMLSerializer.pas 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/experts/stacktraceviewer/JclDebugXMLSerializer.pas 2009-08-10 13:54:58 UTC (rev 2935)
@@ -1,121 +0,0 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) }
-{ }
-{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
-{ you may not use this file except in compliance with the License. You may obtain a copy of the }
-{ License at http://www.mozilla.org/MPL/ }
-{ }
-{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
-{ ANY KIND, either express or implied. See the License for the specific language governing rights }
-{ and limitations under the License. }
-{ }
-{ The Original Code is JclDebugXMLSerializer.pas. }
-{ }
-{ The Initial Developer of the Original Code is Uwe Schuster. }
-{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
-{ }
-{ Contributor(s): }
-{ Uwe Schuster (uschuster) }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: $ }
-{ Revision: $Rev:: $ }
-{ Author: $Author:: $ }
-{ }
-{**************************************************************************************************}
-
-unit JclDebugXMLSerializer;
-
-{$I jcl.inc}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFDEF UNITVERSIONING}
- JclUnitVersioning,
- {$ENDIF UNITVERSIONING}
- JclDebugSerialization;
-
-type
- TJclXMLSerializer = class(TJclCustomSimpleSerializer)
- public
- function SaveToString: string;
- end;
-
-{$IFDEF UNITVERSIONING}
-const
- UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$URL$';
- Revision: '$Revision$';
- Date: '$Date$';
- LogPath: '';
- Extra: '';
- Data: nil
- );
-{$ENDIF UNITVERSIONING}
-
-implementation
-
-//=== { TJclXMLSerializer } ==================================================
-
-function TJclXMLSerializer.SaveToString: string;
-
- procedure AddToStrings(ASerializer: TJclCustomSimpleSerializer; AXMLStrings: TStringList; AIdent: Integer);
- var
- I, P: Integer;
- S, S1, S2, V: string;
- begin
- if AIdent = 0 then
- S := ''
- else
- S := StringOfChar(' ', AIdent);
- V := '';
- for I := 0 to ASerializer.Values.Count - 1 do
- begin
- S1 := ASerializer.Values[I];
- P := Pos('=', S1);
- if P > 0 then
- begin
- S2 := S1;
- Delete(S1, P, Length(S1));
- Delete(S2, 1, P);
- V := V + ' ';
- V := V + Format('%s="%s"', [S1, S2]);
- end;
- end;
- if ASerializer.Count > 0 then
- begin
- AXMLStrings.Add(S + '<' + ASerializer.Name + V + '>');
- for I := 0 to ASerializer.Count - 1 do
- AddToStrings(ASerializer[I], AXMLStrings, AIdent + 2);
- AXMLStrings.Add(S + '</' + ASerializer.Name + '>');
- end
- else
- AXMLStrings.Add(S + '<' + ASerializer.Name + V + '/>');
- end;
-
-
-var
- XMLStrings: TStringList;
-begin
- XMLStrings := TStringList.Create;
- try
- AddToStrings(Self, XMLStrings, 0);
- Result := XMLStrings.Text;
- finally
- XMLStrings.Free;
- end;
-end;
-
-{$IFDEF UNITVERSIONING}
-initialization
- RegisterUnitVersion(HInstance, UnitVersioning);
-
-finalization
- UnregisterUnitVersion(HInstance);
-{$ENDIF UNITVERSIONING}
-
-end.
Modified: trunk/jcl/packages/c6/Jcl.bpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.bpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/Jcl.bpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 30-07-2009 10:40:29 UTC
+ Last generated: 10-08-2009 13:49:47 UTC
*****************************************************************************
-->
<PROJECT>
@@ -69,6 +69,9 @@
..\..\lib\c6\JclCOM.obj
..\..\lib\c6\JclConsole.obj
..\..\lib\c6\JclDebug.obj
+ ..\..\lib\c6\JclDebugSerialization.obj
+ ..\..\lib\c6\JclDebugXMLDeserializer.obj
+ ..\..\lib\c6\JclDebugXMLSerializer.obj
..\..\lib\c6\JclHookExcept.obj
..\..\lib\c6\JclLANMan.obj
..\..\lib\c6\JclLocales.obj
@@ -198,6 +201,9 @@
<FILE FILENAME="..\..\source\windows\JclCOM.pas" FORMNAME="" UNITNAME="JclCOM" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\windows\JclConsole.pas" FORMNAME="" UNITNAME="JclConsole" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\windows\JclDebug.pas" FORMNAME="" UNITNAME="JclDebug" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\..\source\windows\JclDebugSerialization.pas" FORMNAME="" UNITNAME="JclDebugSerialization" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\..\source\windows\JclDebugXMLDeserializer.pas" FORMNAME="" UNITNAME="JclDebugXMLDeserializer" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\..\source\windows\JclDebugXMLSerializer.pas" FORMNAME="" UNITNAME="JclDebugXMLSerializer" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\windows\JclHookExcept.pas" FORMNAME="" UNITNAME="JclHookExcept" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\windows\JclLANMan.pas" FORMNAME="" UNITNAME="JclLANMan" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\windows\JclLocales.pas" FORMNAME="" UNITNAME="JclLocales" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
Modified: trunk/jcl/packages/c6/Jcl.dpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/Jcl.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 30-07-2009 10:40:29 UTC
+ Last generated: 10-08-2009 13:49:47 UTC
-----------------------------------------------------------------------------
}
@@ -97,6 +97,9 @@
JclCOM in '..\..\source\windows\JclCOM.pas' ,
JclConsole in '..\..\source\windows\JclConsole.pas' ,
JclDebug in '..\..\source\windows\JclDebug.pas' ,
+ JclDebugSerialization in '..\..\source\windows\JclDebugSerialization.pas' ,
+ JclDebugXMLDeserializer in '..\..\source\windows\JclDebugXMLDeserializer.pas' ,
+ JclDebugXMLSerializer in '..\..\source\windows\JclDebugXMLSerializer.pas' ,
JclHookExcept in '..\..\source\windows\JclHookExcept.pas' ,
JclLANMan in '..\..\source\windows\JclLANMan.pas' ,
JclLocales in '..\..\source\windows\JclLocales.pas' ,
Modified: trunk/jcl/packages/c6/JclStackTraceViewerExpert.bpk
===================================================================
--- trunk/jcl/packages/c6/JclStackTraceViewerExpert.bpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/JclStackTraceViewerExpert.bpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpert-D.xml)
- Last generated: 24-07-2009 09:49:30 UTC
+ Last generated: 10-08-2009 13:49:47 UTC
*****************************************************************************
-->
<PROJECT>
@@ -28,8 +28,6 @@
..\..\lib\c6\JclStackTraceViewerAPIImpl.obj
..\..\lib\c6\JclStackTraceViewerAPI.obj
..\..\lib\c6\JclStackTraceViewerStackUtils.obj
- ..\..\lib\c6\JclDebugSerialization.obj
- ..\..\lib\c6\JclDebugXMLDeserializer.obj
"/>
<RESFILES value="JclStackTraceViewerExpert.res"/>
<IDLFILES value=""/>
@@ -109,8 +107,6 @@
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas" FORMNAME="" UNITNAME="JclStackTraceViewerAPIImpl" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas" FORMNAME="" UNITNAME="JclStackTraceViewerAPI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas" FORMNAME="" UNITNAME="JclStackTraceViewerStackUtils" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\..\experts\stacktraceviewer\JclDebugSerialization.pas" FORMNAME="" UNITNAME="JclDebugSerialization" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas" FORMNAME="" UNITNAME="JclDebugXMLDeserializer" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
</FILELIST>
<BUILDTOOLS>
</BUILDTOOLS>
Modified: trunk/jcl/packages/c6/JclStackTraceViewerExpert.dpk
===================================================================
--- trunk/jcl/packages/c6/JclStackTraceViewerExpert.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/JclStackTraceViewerExpert.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpert-D.xml)
- Last generated: 24-07-2009 09:49:30 UTC
+ Last generated: 10-08-2009 13:49:47 UTC
-----------------------------------------------------------------------------
}
@@ -59,8 +59,6 @@
JclStackTraceViewerOptions in '..\..\experts\stacktraceviewer\JclStackTraceViewerOptions.pas' ,
JclStackTraceViewerAPIImpl in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas' ,
JclStackTraceViewerAPI in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas' ,
- JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas' ,
- JclDebugSerialization in '..\..\experts\stacktraceviewer\JclDebugSerialization.pas' ,
- JclDebugXMLDeserializer in '..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas'
+ JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas'
;
end.
Modified: trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpf
===================================================================
--- trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpf 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpf 2009-08-10 13:54:58 UTC (rev 2935)
@@ -12,8 +12,6 @@
USEUNIT("..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas");
USEUNIT("..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas");
USEUNIT("..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas");
-USEUNIT("..\..\experts\stacktraceviewer\JclDebugSerialization.pas");
-USEUNIT("..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas");
USEDEF("JclStackTraceViewerExpertDLL.def");
Project file
DllEntryPoint
Modified: trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpr
===================================================================
--- trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpr 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/c6/JclStackTraceViewerExpertDLL.bpr 2009-08-10 13:54:58 UTC (rev 2935)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpertDLL-L.xml)
- Last generated: 24-07-2009 09:49:30 UTC
+ Last generated: 10-08-2009 13:49:47 UTC
*****************************************************************************
-->
<PROJECT>
@@ -28,8 +28,6 @@
..\..\lib\c6\JclStackTraceViewerAPIImpl.obj
..\..\lib\c6\JclStackTraceViewerAPI.obj
..\..\lib\c6\JclStackTraceViewerStackUtils.obj
- ..\..\lib\c6\JclDebugSerialization.obj
- ..\..\lib\c6\JclDebugXMLDeserializer.obj
"/>
<RESFILES value=""/>
<IDLFILES value=""/>
@@ -108,8 +106,6 @@
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas" FORMNAME="" UNITNAME="JclStackTraceViewerAPIImpl" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas" FORMNAME="" UNITNAME="JclStackTraceViewerAPI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas" FORMNAME="" UNITNAME="JclStackTraceViewerStackUtils" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\..\experts\stacktraceviewer\JclDebugSerialization.pas" FORMNAME="" UNITNAME="JclDebugSerialization" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas" FORMNAME="" UNITNAME="JclDebugXMLDeserializer" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
</FILELIST>
<BUILDTOOLS>
</BUILDTOOLS>
Modified: trunk/jcl/packages/d10/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d10/Jcl.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d10/Jcl.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 30-07-2009 10:40:29 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -98,6 +98,9 @@
JclCOM in '..\..\source\windows\JclCOM.pas' ,
JclConsole in '..\..\source\windows\JclConsole.pas' ,
JclDebug in '..\..\source\windows\JclDebug.pas' ,
+ JclDebugSerialization in '..\..\source\windows\JclDebugSerialization.pas' ,
+ JclDebugXMLDeserializer in '..\..\source\windows\JclDebugXMLDeserializer.pas' ,
+ JclDebugXMLSerializer in '..\..\source\windows\JclDebugXMLSerializer.pas' ,
JclDotNet in '..\..\source\windows\JclDotNet.pas' ,
JclHookExcept in '..\..\source\windows\JclHookExcept.pas' ,
JclLANMan in '..\..\source\windows\JclLANMan.pas' ,
Modified: trunk/jcl/packages/d10/JclStackTraceViewerExpert.dpk
===================================================================
--- trunk/jcl/packages/d10/JclStackTraceViewerExpert.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d10/JclStackTraceViewerExpert.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpert-D.xml)
- Last generated: 13-06-2009 11:28:21 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -60,9 +60,7 @@
JclStackTraceViewerOptions in '..\..\experts\stacktraceviewer\JclStackTraceViewerOptions.pas' ,
JclStackTraceViewerAPIImpl in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas' ,
JclStackTraceViewerAPI in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas' ,
- JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas' ,
- JclDebugSerialization in '..\..\experts\stacktraceviewer\JclDebugSerialization.pas' ,
- JclDebugXMLDeserializer in '..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas'
+ JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas'
;
end.
Modified: trunk/jcl/packages/d10/JclStackTraceViewerExpertDLL.dpr
===================================================================
--- trunk/jcl/packages/d10/JclStackTraceViewerExpertDLL.dpr 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d10/JclStackTraceViewerExpertDLL.dpr 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpertDLL-L.xml)
- Last generated: 13-06-2009 11:28:22 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -52,9 +52,7 @@
JclStackTraceViewerOptions in '..\..\experts\stacktraceviewer\JclStackTraceViewerOptions.pas' ,
JclStackTraceViewerAPIImpl in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas' ,
JclStackTraceViewerAPI in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas' ,
- JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas' ,
- JclDebugSerialization in '..\..\experts\stacktraceviewer\JclDebugSerialization.pas' ,
- JclDebugXMLDeserializer in '..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas'
+ JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas'
;
exports
Modified: trunk/jcl/packages/d11/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d11/Jcl.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/Jcl.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 30-07-2009 10:40:29 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -98,6 +98,9 @@
JclCOM in '..\..\source\windows\JclCOM.pas' ,
JclConsole in '..\..\source\windows\JclConsole.pas' ,
JclDebug in '..\..\source\windows\JclDebug.pas' ,
+ JclDebugSerialization in '..\..\source\windows\JclDebugSerialization.pas' ,
+ JclDebugXMLDeserializer in '..\..\source\windows\JclDebugXMLDeserializer.pas' ,
+ JclDebugXMLSerializer in '..\..\source\windows\JclDebugXMLSerializer.pas' ,
JclDotNet in '..\..\source\windows\JclDotNet.pas' ,
JclHookExcept in '..\..\source\windows\JclHookExcept.pas' ,
JclLANMan in '..\..\source\windows\JclLANMan.pas' ,
Modified: trunk/jcl/packages/d11/Jcl.dproj
===================================================================
--- trunk/jcl/packages/d11/Jcl.dproj 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/Jcl.dproj 2009-08-10 13:54:58 UTC (rev 2935)
@@ -141,6 +141,9 @@
<DCCReference Include="..\..\source\windows\JclCOM.pas" />
<DCCReference Include="..\..\source\windows\JclConsole.pas" />
<DCCReference Include="..\..\source\windows\JclDebug.pas" />
+ <DCCReference Include="..\..\source\windows\JclDebugSerialization.pas" />
+ <DCCReference Include="..\..\source\windows\JclDebugXMLDeserializer.pas" />
+ <DCCReference Include="..\..\source\windows\JclDebugXMLSerializer.pas" />
<DCCReference Include="..\..\source\windows\JclDotNet.pas" />
<DCCReference Include="..\..\source\windows\JclHookExcept.pas" />
<DCCReference Include="..\..\source\windows\JclLANMan.pas" />
Modified: trunk/jcl/packages/d11/JclStackTraceViewerExpert.dpk
===================================================================
--- trunk/jcl/packages/d11/JclStackTraceViewerExpert.dpk 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/JclStackTraceViewerExpert.dpk 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpert-D.xml)
- Last generated: 18-05-2009 18:51:06 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -60,9 +60,7 @@
JclStackTraceViewerOptions in '..\..\experts\stacktraceviewer\JclStackTraceViewerOptions.pas' ,
JclStackTraceViewerAPIImpl in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas' ,
JclStackTraceViewerAPI in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas' ,
- JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas' ,
- JclDebugSerialization in '..\..\experts\stacktraceviewer\JclDebugSerialization.pas' ,
- JclDebugXMLDeserializer in '..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas'
+ JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas'
;
end.
Modified: trunk/jcl/packages/d11/JclStackTraceViewerExpert.dproj
===================================================================
--- trunk/jcl/packages/d11/JclStackTraceViewerExpert.dproj 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/JclStackTraceViewerExpert.dproj 2009-08-10 13:54:58 UTC (rev 2935)
@@ -104,7 +104,5 @@
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas" />
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas" />
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas" />
- <DCCReference Include="..\..\experts\stacktraceviewer\JclDebugSerialization.pas" />
- <DCCReference Include="..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas" />
</ItemGroup>
</Project>
Modified: trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dpr
===================================================================
--- trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dpr 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dpr 2009-08-10 13:54:58 UTC (rev 2935)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclStackTraceViewerExpertDLL-L.xml)
- Last generated: 18-05-2009 18:51:06 UTC
+ Last generated: 10-08-2009 13:49:49 UTC
-----------------------------------------------------------------------------
}
@@ -52,9 +52,7 @@
JclStackTraceViewerOptions in '..\..\experts\stacktraceviewer\JclStackTraceViewerOptions.pas' ,
JclStackTraceViewerAPIImpl in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas' ,
JclStackTraceViewerAPI in '..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas' ,
- JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas' ,
- JclDebugSerialization in '..\..\experts\stacktraceviewer\JclDebugSerialization.pas' ,
- JclDebugXMLDeserializer in '..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas'
+ JclStackTraceViewerStackUtils in '..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas'
;
exports
Modified: trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dproj
===================================================================
--- trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dproj 2009-08-10 10:02:59 UTC (rev 2934)
+++ trunk/jcl/packages/d11/JclStackTraceViewerExpertDLL.dproj 2009-08-10 13:54:58 UTC (rev 2935)
@@ -104,7 +104,5 @@
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerAPIImpl.pas" />
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerAPI.pas" />
<DCCReference Include="..\..\experts\stacktraceviewer\JclStackTraceViewerStackUtils.pas" />
- <DCCReference Include="..\..\experts\stacktraceviewer\JclDebugSerialization.pas" />
- <DCCReference Include="..\..\experts\stacktraceviewer\JclDebugXMLDeserializer.pas" />
</ItemGroup>
</Project>
M...
[truncated message content] |
|
From: <ou...@us...> - 2009-08-10 10:03:06
|
Revision: 2934
http://jcl.svn.sourceforge.net/jcl/?rev=2934&view=rev
Author: outchy
Date: 2009-08-10 10:02:59 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
revert the frame location storage in the class TJclExceptFrame.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-08-10 10:00:38 UTC (rev 2933)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-08-10 10:02:59 UTC (rev 2934)
@@ -34,7 +34,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -739,15 +739,17 @@
TJclExceptFrame = class(TObject)
private
FFrameKind: TExceptFrameKind;
+ FFrameLocation: Pointer;
FCodeLocation: Pointer;
FExcTab: array of TExcDescEntry;
protected
procedure AnalyseExceptFrame(AExcDesc: PExcDesc);
public
- constructor Create(AExcDesc: PExcDesc);
+ constructor Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
function Handles(ExceptObj: TObject): Boolean;
function HandlerInfo(ExceptObj: TObject; out HandlerAt: Pointer): Boolean;
property CodeLocation: Pointer read FCodeLocation;
+ property FrameLocation: Pointer read FFrameLocation;
property FrameKind: TExceptFrameKind read FFrameKind;
end;
@@ -5123,10 +5125,11 @@
//=== { TJclExceptFrame } ====================================================
-constructor TJclExceptFrame.Create(AExcDesc: PExcDesc);
+constructor TJclExceptFrame.Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
begin
inherited Create;
FFrameKind := efkUnknown;
+ FFrameLocation := AFrameLocation;
FCodeLocation := nil;
AnalyseExceptFrame(AExcDesc);
end;
@@ -5257,7 +5260,7 @@
function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame;
begin
- Result := TJclExceptFrame.Create(AFrame^.Desc);
+ Result := TJclExceptFrame.Create(AFrame, AFrame^.Desc);
Add(Result);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 10:00:45
|
Revision: 2933
http://jcl.svn.sourceforge.net/jcl/?rev=2933&view=rev
Author: outchy
Date: 2009-08-10 10:00:38 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
revert the frame location storage in the class TJclExceptFrame.
fix compilation of the frame stack example.
Modified Paths:
--------------
trunk/jcl/examples/windows/debug/framestrack/FramesTrackDemoMain.pas
Modified: trunk/jcl/examples/windows/debug/framestrack/FramesTrackDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/debug/framestrack/FramesTrackDemoMain.pas 2009-08-10 09:47:41 UTC (rev 2932)
+++ trunk/jcl/examples/windows/debug/framestrack/FramesTrackDemoMain.pas 2009-08-10 10:00:38 UTC (rev 2933)
@@ -82,7 +82,7 @@
ModInfo := GetLocationInfo(HandlerLocation);
TmpS := Format(
' Frame at $%p (type: %s',
- [ExceptFrame.ExcFrame,
+ [ExceptFrame.FrameLocation,
GetEnumName(TypeInfo(TExceptFrameKind), Ord(ExceptFrame.FrameKind))]);
if ExceptionHandled then
TmpS := TmpS + ', handles exception)'
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 09:47:48
|
Revision: 2932
http://jcl.svn.sourceforge.net/jcl/?rev=2932&view=rev
Author: outchy
Date: 2009-08-10 09:47:41 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
fix warnings in examples.
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UMain.pas
trunk/jcl/examples/windows/filesummary/FileSummaryDemoMain.pas
trunk/jcl/examples/windows/mapi/MapiDemoMain.pas
Modified: trunk/jcl/examples/windows/compression/archive/UMain.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-08-09 17:36:17 UTC (rev 2931)
+++ trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-08-10 09:47:41 UTC (rev 2932)
@@ -1,6 +1,7 @@
unit UMain;
{$I jcl.inc}
+{$I windowsonly.inc}
interface
@@ -563,4 +564,4 @@
if not Load7Zip then
raise EJclCompressionError.Create('Cannot load sevenzip library');
-end.
\ No newline at end of file
+end.
Modified: trunk/jcl/examples/windows/filesummary/FileSummaryDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/filesummary/FileSummaryDemoMain.pas 2009-08-09 17:36:17 UTC (rev 2931)
+++ trunk/jcl/examples/windows/filesummary/FileSummaryDemoMain.pas 2009-08-10 09:47:41 UTC (rev 2932)
@@ -1,5 +1,8 @@
unit FileSummaryDemoMain;
+{$I jcl.inc}
+{$I windowsonly.inc}
+
interface
uses
Modified: trunk/jcl/examples/windows/mapi/MapiDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/mapi/MapiDemoMain.pas 2009-08-09 17:36:17 UTC (rev 2931)
+++ trunk/jcl/examples/windows/mapi/MapiDemoMain.pas 2009-08-10 09:47:41 UTC (rev 2932)
@@ -185,7 +185,7 @@
SimpleMapiMail.Body := AnsiString(BodyEdit.Text);
SimpleMapiMail.HtmlBody := HtmlCheckBox.Checked;
if OpenDialog1.FileName <> '' then
- SimpleMapiMail.Attachments.Add(OpenDialog1.FileName);
+ SimpleMapiMail.Attachments.Add(AnsiString(OpenDialog1.FileName));
SimpleMapiMail.Save;
end;
@@ -207,7 +207,7 @@
SimpleMapiMail.Body := AnsiString(BodyEdit.Text);
SimpleMapiMail.HtmlBody := HtmlCheckBox.Checked;
if OpenDialog1.FileName <> '' then
- SimpleMapiMail.Attachments.Add(OpenDialog1.FileName);
+ SimpleMapiMail.Attachments.Add(AnsiString(OpenDialog1.FileName));
SimpleMapiMail.Send(DialogCheckBox.Checked);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 17:36:28
|
Revision: 2931
http://jcl.svn.sourceforge.net/jcl/?rev=2931&view=rev
Author: outchy
Date: 2009-08-09 17:36:17 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
C5 and D5 support removal.
Modified Paths:
--------------
trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
trunk/jcl/examples/common/graphics/StretchGraphicDemoMain.pas
trunk/jcl/examples/windows/tasks/TaskDemoMain.pas
trunk/jcl/install/JediRegInfo.pas
trunk/jcl/source/common/JclBase.pas
Modified: trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
===================================================================
--- trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2009-08-09 17:06:40 UTC (rev 2930)
+++ trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2009-08-09 17:36:17 UTC (rev 2931)
@@ -22,20 +22,13 @@
uses
SysUtils, Forms, Controls, Math,
- {$IFDEF RTL140_UP}
Contnrs, IniFiles,
- {$ENDIF RTL140_UP}
JclContainerIntf, JclArrayLists, JclLinkedLists, JclHashMaps, JclVectors;
const
ResultFormat = '%.1f ms';
MsecsPerDay = 24 * 60 * 60 * 1000;
-{$IFNDEF RTL140_UP}
-const
- SNeedRTL140Up = 'requires RTL > 14.0';
-{$ENDIF ~RTL140_UP}
-
var
Res: Integer;
@@ -194,7 +187,6 @@
end;
procedure TestBucketList(Results: TStrings);
-{$IFDEF RTL140_UP}
var
I: Integer;
Start: TDateTime;
@@ -220,14 +212,6 @@
Screen.Cursor := crDefault;
end;
end;
-{$ELSE ~RTL140_UP}
-var
- I: Integer;
-begin
- for I := 1 to 3 do
- Results[I] := SNeedRTL140Up;
-end;
-{$ENDIF ~RTL140_UP}
procedure TestJclHashMap(Results: TStrings);
var
@@ -261,7 +245,6 @@
end;
procedure TestHashedStringList(Results: TStrings);
-{$IFDEF RTL140_UP}
var
I: Integer;
List: THashedStringList;
@@ -287,14 +270,6 @@
Screen.Cursor := crDefault;
end;
end;
-{$ELSE ~RTL140_UP}
-var
- I: Integer;
-begin
- for I := 1 to 3 do
- Results[I] := SNeedRTL140Up;
-end;
-{$ENDIF ~RTL140_UP}
procedure TestJclAnsiStrAnsiStrHashMap(Results: TStrings);
var
Modified: trunk/jcl/examples/common/graphics/StretchGraphicDemoMain.pas
===================================================================
--- trunk/jcl/examples/common/graphics/StretchGraphicDemoMain.pas 2009-08-09 17:06:40 UTC (rev 2930)
+++ trunk/jcl/examples/common/graphics/StretchGraphicDemoMain.pas 2009-08-09 17:36:17 UTC (rev 2931)
@@ -5,11 +5,9 @@
{$I jcl.inc}
-{$IFDEF RTL140_UP}
- {$IFDEF VCL}
- {$DEFINE HasShellCtrls} // $(Delphi)\Demos\ShellControls\ShellCtrls.pas
- {$ENDIF VCL}
-{$ENDIF RTL140_UP}
+{$IFDEF VCL}
+ {$DEFINE HasShellCtrls} // $(Delphi)\Demos\ShellControls\ShellCtrls.pas
+{$ENDIF VCL}
unit StretchGraphicDemoMain;
Modified: trunk/jcl/examples/windows/tasks/TaskDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/tasks/TaskDemoMain.pas 2009-08-09 17:06:40 UTC (rev 2930)
+++ trunk/jcl/examples/windows/tasks/TaskDemoMain.pas 2009-08-09 17:36:17 UTC (rev 2931)
@@ -7,10 +7,7 @@
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Menus, ExtCtrls, OleCtrls, SHDocVw,
- {$IFDEF RTL140_UP}
- HTTPProd,
- {$ENDIF}
- HTTPApp;
+ HTTPProd, HTTPApp;
type
TfrmMain = class(TForm)
@@ -92,11 +89,7 @@
var
I: Integer;
begin
- {$IFDEF RTL140_UP}
lstTasks.Clear;
- {$ELSE}
- lstTasks.Items.Clear;
- {$ENDIF}
for I:=0 to DM.Task.TaskCount-1 do
with lstTasks.Items.Add, DM.Task[I] do
begin
Modified: trunk/jcl/install/JediRegInfo.pas
===================================================================
--- trunk/jcl/install/JediRegInfo.pas 2009-08-09 17:06:40 UTC (rev 2930)
+++ trunk/jcl/install/JediRegInfo.pas 2009-08-09 17:36:17 UTC (rev 2931)
@@ -80,16 +80,6 @@
uses
Registry;
-{$IFNDEF RTL140_UP}
-function ExcludeTrailingPathDelimiter(const Path: string): string;
-begin
- if (Path <> '') and (Path[Length(Path)] = '\') then
- Result := Copy(Path, 1, Length(Path) - 1)
- else
- Result := Path;
-end;
-{$ENDIF ~RTL140_UP}
-
function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
BplDir, RootDir: string; RootKey: HKEY): Boolean;
var
Modified: trunk/jcl/source/common/JclBase.pas
===================================================================
--- trunk/jcl/source/common/JclBase.pas 2009-08-09 17:06:40 UTC (rev 2930)
+++ trunk/jcl/source/common/JclBase.pas 2009-08-09 17:36:17 UTC (rev 2931)
@@ -113,18 +113,6 @@
PPInt64 = ^PInt64;
PPPAnsiChar = ^PPAnsiChar;
-// Interface compatibility
-{$IFDEF SUPPORTS_INTERFACE}
-{$IFNDEF FPC}
-{$IFNDEF RTL140_UP}
-
-type
- IInterface = IUnknown;
-
-{$ENDIF ~RTL140_UP}
-{$ENDIF ~FPC}
-{$ENDIF SUPPORTS_INTERFACE}
-
// Int64 support
procedure I64ToCardinals(I: Int64; out LowPart, HighPart: Cardinal);
procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 17:06:55
|
Revision: 2930
http://jcl.svn.sourceforge.net/jcl/?rev=2930&view=rev
Author: outchy
Date: 2009-08-09 17:06:40 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
JclStream.StreamSeek was there for D5 and C5 compatibility, this function can now be deprecated.
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
trunk/jcl/source/common/JclCompression.pas
trunk/jcl/source/common/JclSimpleXml.pas
trunk/jcl/source/common/JclStreams.pas
trunk/jcl/source/common/JclStrings.pas
trunk/jcl/source/common/JclUnicode.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -3285,7 +3285,7 @@
FS := TFileStream.Create(FileName, fmCreate);
try
if Append then
- StreamSeek(FS, 0, soEnd); // faster than .Position := .Size
+ FS.Seek(0, soEnd); // faster than .Position := .Size
Len := Length(Contents);
if Len > 0 then
FS.WriteBuffer(Contents[1], Len);
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclCompression.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -4297,7 +4297,7 @@
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
Result := AVolume.Stream;
if Assigned(Result) then
- StreamSeek(Result, 0, soBeginning);
+ Result.Seek(0, soBeginning);
end
else
FVolumeIndex := Index;
@@ -4860,8 +4860,8 @@
if (SrcFileName = '') and (DestFileName = '') and Assigned(SrcStream) and Assigned(DestStream) then
begin
// in-memory moves
- StreamSeek(SrcStream, 0, soBeginning);
- StreamSeek(DestStream, 0, soBeginning);
+ SrcStream.Seek(0, soBeginning);
+ DestStream.Seek(0, soBeginning);
CopiedSize := StreamCopy(SrcStream, DestStream);
// reset size
DestStream.Size := CopiedSize;
@@ -4970,7 +4970,7 @@
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
Result := AVolume.TmpStream;
if Assigned(Result) then
- StreamSeek(Result, 0, soBeginning);
+ Result.Seek(0, soBeginning);
end
else
FTmpVolumeIndex := Index;
@@ -5070,7 +5070,7 @@
// STREAM_SEEK_SET = 0 = soFromBeginning
// STREAM_SEEK_CUR = 1 = soFromCurrent
// STREAM_SEEK_END = 2 = soFromEnd
- NewPos := StreamSeek(FStream, Offset, TSeekOrigin(SeekOrigin));
+ NewPos := FStream.Seek(Offset, TSeekOrigin(SeekOrigin));
if Assigned(NewPosition) then
NewPosition^ := NewPos;
end;
@@ -5205,7 +5205,7 @@
// STREAM_SEEK_SET = 0 = soFromBeginning
// STREAM_SEEK_CUR = 1 = soFromCurrent
// STREAM_SEEK_END = 2 = soFromEnd
- NewPos := StreamSeek(FStream, Offset, TSeekOrigin(SeekOrigin));
+ NewPos := FStream.Seek(Offset, TSeekOrigin(SeekOrigin));
if Assigned(NewPosition) then
NewPosition^ := NewPos;
Result := S_OK;
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -988,7 +988,7 @@
AOutStream := TMemoryStream.Create;
DoFree := True;
FOnDecodeStream(Self, Stream, AOutStream);
- StreamSeek(AOutStream, 0, soBeginning);
+ AOutStream.Seek(0, soBeginning);
end
else
AOutStream := Stream;
@@ -1148,7 +1148,7 @@
end;
if Assigned(FOnEncodeStream) then
begin
- StreamSeek(AOutStream, 0, soBeginning);
+ AOutStream.Seek(0, soBeginning);
FOnEncodeStream(Self, AOutStream, Stream);
end;
finally
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclStreams.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -527,10 +527,12 @@
property Encoding: TJclStringEncoding read FEncoding;
end;
+{$IFDEF KEEP_DEPRECATED}
// call TStream.Seek(Int64,TSeekOrigin) if present (TJclStream or COMPILER6_UP)
// otherwize call TStream.Seek(LongInt,Word) with range checking
function StreamSeek(Stream: TStream; const Offset: Int64;
const Origin: TSeekOrigin): Int64;
+{$ENDIF KEEP_DEPRECATED}
// buffered copy of all available bytes from Source to Dest
// returns the number of bytes that were copied
@@ -564,6 +566,7 @@
uses
JclResources, JclCharsets, JclMath, JclSysUtils;
+{$IFDEF KEEP_DEPRECATED}
function StreamSeek(Stream: TStream; const Offset: Int64;
const Origin: TSeekOrigin): Int64; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
begin
@@ -572,6 +575,7 @@
else
Result := -1;
end;
+{$ENDIF KEEP_DEPRECATED}
function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint): Int64;
var
@@ -1157,7 +1161,7 @@
function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
- Result := StreamSeek(Stream, Offset, Origin);
+ Result := Stream.Seek(Offset, Origin);
end;
procedure TJclStreamDecorator.SetSize(const NewSize: Int64);
@@ -1756,7 +1760,7 @@
if (Offset < 0) or ((MaxSize >= 0) and (Offset > MaxSize)) then
Result := -1 // low and high bound check
else
- Result := StreamSeek(ParentStream, StartPos + Offset, soBeginning) - StartPos;
+ Result := ParentStream.Seek(StartPos + Offset, soBeginning) - StartPos;
end;
soCurrent:
begin
@@ -1766,7 +1770,7 @@
and ((FCurrentPos + Offset) > MaxSize)) then
Result := -1 // low and high bound check
else
- Result := StreamSeek(ParentStream, Offset, soCurrent) - StartPos;
+ Result := ParentStream.Seek(Offset, soCurrent) - StartPos;
end;
soEnd:
begin
@@ -1775,15 +1779,15 @@
if (Offset > 0) or (MaxSize < -Offset) then // low and high bound check
Result := -1
else
- Result := StreamSeek(ParentStream, StartPos + MaxSize + Offset, soBeginning) - StartPos;
+ Result := ParentStream.Seek(StartPos + MaxSize + Offset, soBeginning) - StartPos;
end
else
begin
- Result := StreamSeek(ParentStream, Offset, soEnd);
+ Result := ParentStream.Seek(Offset, soEnd);
if (Result <> -1) and (Result < StartPos) then // low bound check
begin
Result := -1;
- StreamSeek(ParentStream, StartPos + FCurrentPos, soBeginning);
+ ParentStream.Seek(StartPos + FCurrentPos, soBeginning);
end;
end;
end;
@@ -2036,7 +2040,7 @@
InternalLoadVolume(OldVolumeIndex);
FPosition := OldPosition;
if Assigned(FVolume) then
- FVolumePosition := StreamSeek(FVolume, OldVolumePosition, soBeginning);
+ FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning);
end;
end;
@@ -2063,7 +2067,7 @@
FVolumeMaxSize := GetVolumeMaxSize(Index);
Result := Assigned(FVolume);
if Result then
- StreamSeek(FVolume, 0, soBeginning)
+ FVolume.Seek(0, soBeginning)
else
begin
// restore old pointers if volume load failed
@@ -2093,7 +2097,7 @@
repeat
// force position
if ForcePosition then
- StreamSeek(FVolume, FVolumePosition, soBeginning);
+ FVolume.Seek(FVolumePosition, soBeginning);
// try to read (Count) bytes from current stream
LoopRead := FVolume.Read(Data^, Count);
@@ -2138,7 +2142,7 @@
if FVolumePosition >= -RemainingOffset then
begin
// seek in current volume
- FVolumePosition := StreamSeek(FVolume, FVolumePosition + RemainingOffset, soBeginning);
+ FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning);
Result := Result + RemainingOffset;
FPosition := Result;
RemainingOffset := 0;
@@ -2152,7 +2156,7 @@
RemainingOffset := RemainingOffset + FVolumePosition;
Result := Result - FVolumePosition;
FPosition := Result;
- FVolumePosition := StreamSeek(FVolume, 0, soBeginning);
+ FVolumePosition := FVolume.Seek(0, soBeginning);
// load previous volume
if not InternalLoadVolume(FVolumeIndex - 1) then
Break;
@@ -2167,7 +2171,7 @@
if (FVolumeMaxSize = 0) or ((FVolumePosition + RemainingOffset) < FVolumeMaxSize) then
begin
// can seek in current volume
- FVolumePosition := StreamSeek(FVolume, FVolumePosition + RemainingOffset, soBeginning);
+ FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning);
Result := Result + RemainingOffset;
FPosition := Result;
RemainingOffset := 0;
@@ -2213,7 +2217,7 @@
InternalLoadVolume(OldVolumeIndex);
FPosition := OldPosition;
if Assigned(FVolume) then
- FVolumePosition := StreamSeek(FVolume, OldVolumePosition, soBeginning);
+ FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning);
end;
end;
@@ -2233,7 +2237,7 @@
repeat
// force position
if ForcePosition then
- StreamSeek(FVolume, FVolumePosition, soBeginning);
+ FVolume.Seek(FVolumePosition, soBeginning);
// do not write more than (VolumeMaxSize) bytes in current stream
if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclStrings.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -49,7 +49,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -3240,7 +3240,7 @@
FS := TFileStream.Create(FileName, fmCreate);
try
if Append then
- StreamSeek(FS, 0, soEnd); // faster than .Position := .Size
+ FS.Seek(0, soEnd); // faster than .Position := .Size
Len := Length(Contents);
if Len > 0 then
FS.WriteBuffer(Contents[1], Len);
Modified: trunk/jcl/source/common/JclUnicode.pas
===================================================================
--- trunk/jcl/source/common/JclUnicode.pas 2009-08-09 16:34:56 UTC (rev 2929)
+++ trunk/jcl/source/common/JclUnicode.pas 2009-08-09 17:06:40 UTC (rev 2930)
@@ -1355,7 +1355,7 @@
try
RawStream := TMemoryStream.Create;
StreamCopy(DecompressionStream, RawStream);
- StreamSeek(RawStream, 0, soBeginning);
+ RawStream.Seek(0, soBeginning);
Result := TJclEasyStream.Create(RawStream, True);
finally
DecompressionStream.Free;
@@ -1371,7 +1371,7 @@
try
RawStream := TMemoryStream.Create;
StreamCopy(DecompressionStream, RawStream);
- StreamSeek(RawStream, 0, soBeginning);
+ RawStream.Seek(0, soBeginning);
Result := TJclEasyStream.Create(RawStream, True);
finally
DecompressionStream.Free;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 16:35:06
|
Revision: 2929
http://jcl.svn.sourceforge.net/jcl/?rev=2929&view=rev
Author: outchy
Date: 2009-08-09 16:34:56 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
makes log faster (avoid repetitive openings and closings).
Modified Paths:
--------------
trunk/jcl/install/JclInstall.pas
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2009-08-09 16:29:00 UTC (rev 2928)
+++ trunk/jcl/install/JclInstall.pas 2009-08-09 16:34:56 UTC (rev 2929)
@@ -2046,6 +2046,7 @@
Index: Integer;
ATarget: TJclBorRADToolInstallation;
begin
+ FLogLines.OpenLog;
AProfilesManager := InstallCore.ProfilesManager;
try
Target.OutputCallback := WriteLog;
@@ -2097,6 +2098,7 @@
WriteLog('');
if Assigned(GUIPage) then
GUIPage.EndInstall;
+ FLogLines.CloseLog;
end;
end;
@@ -2366,6 +2368,7 @@
AProfilesManager: IJediProfilesManager;
ATarget: TJclBorRADToolInstallation;
begin
+ FLogLines.OpenLog;
AProfilesManager := InstallCore.ProfilesManager;
try
Target.OutputCallback := WriteLog;
@@ -2418,6 +2421,7 @@
// TODO: ioJclMakeDemos:
finally
Target.OutputCallback := nil;
+ FLogLines.CloseLog;
end;
Result := True;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 16:29:06
|
Revision: 2928
http://jcl.svn.sourceforge.net/jcl/?rev=2928&view=rev
Author: outchy
Date: 2009-08-09 16:29:00 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
always close the pipes and terminate the process when an exception is raised from the callback event.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-08-09 16:27:13 UTC (rev 2927)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-08-09 16:29:00 UTC (rev 2928)
@@ -2527,47 +2527,49 @@
function InternalExecute(CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
RawOutput: Boolean; AbortPtr: PBoolean): Cardinal;
+
const
BufferSize = 255;
-var
- Buffer: array [0..BufferSize] of AnsiChar;
- TempOutput: string;
- PipeBytesRead: Cardinal;
+type
+ TBuffer = array [0..BufferSize] of AnsiChar;
- procedure ProcessLine(LineEnd: Integer);
+ procedure ProcessLine(const Line: string; LineEnd: Integer);
begin
- if RawOutput or (TempOutput[LineEnd] <> NativeCarriageReturn) then
+ if RawOutput or (Line[LineEnd] <> NativeCarriageReturn) then
begin
- while (LineEnd > 0) and CharIsReturn(TempOutput[LineEnd]) do
+ while (LineEnd > 0) and CharIsReturn(Line[LineEnd]) do
Dec(LineEnd);
- OutputLineCallback(Copy(TempOutput, 1, LineEnd));
+ OutputLineCallback(Copy(Line, 1, LineEnd));
end;
end;
- procedure ProcessBuffer;
+ procedure ProcessBuffer(var Buffer: TBuffer; var Line: string; PipeBytesRead: Cardinal);
var
CR, LF: Integer;
begin
Buffer[PipeBytesRead] := #0;
- TempOutput := TempOutput + string(Buffer);
+ Line := Line + string(Buffer);
if Assigned(OutputLineCallback) then
repeat
- CR := Pos(NativeCarriageReturn, TempOutput);
- if CR = Length(TempOutput) then
+ CR := Pos(NativeCarriageReturn, Line);
+ if CR = Length(Line) then
CR := 0; // line feed at CR + 1 might be missing
- LF := Pos(NativeLineFeed, TempOutput);
+ LF := Pos(NativeLineFeed, Line);
if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
LF := CR; // accept CR as line end
if LF > 0 then
begin
- ProcessLine(LF);
- Delete(TempOutput, 1, LF);
+ ProcessLine(Line, LF);
+ Delete(Line, 1, LF);
end;
until LF = 0;
end;
+var
+ Buffer: TBuffer;
+ Line: string;
+ PipeBytesRead: Cardinal;
{$IFDEF MSWINDOWS}
-// "outsourced" from Win32ExecAndRedirectOutput
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
@@ -2580,6 +2582,8 @@
SecurityAttr.bInheritHandle := True;
PipeWrite := 0;
PipeRead := 0;
+ Line := '';
+ ResetMemory(Buffer, SizeOf(Buffer));
if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then
begin
Result := GetLastError;
@@ -2594,31 +2598,54 @@
StartupInfo.hStdError := PipeWrite;
UniqueString(CommandLine); // CommandLine must be in a writable memory block
ProcessInfo.dwProcessId := 0;
- if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
- nil, nil, StartupInfo, ProcessInfo) then
- begin
- CloseHandle(PipeWrite);
- if AbortPtr <> nil then
- {$IFDEF FPC}
- AbortPtr^ := 0;
- {$ELSE ~FPC}
- AbortPtr^ := False;
- {$ENDIF ~FPC}
- PipeBytesRead := 0;
- while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
- ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
- ProcessBuffer;
- if (AbortPtr <> nil) and LongBool(AbortPtr^) then
+ try
+ if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
+ nil, nil, StartupInfo, ProcessInfo) then
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ if AbortPtr <> nil then
+ {$IFDEF FPC}
+ AbortPtr^ := 0;
+ {$ELSE ~FPC}
+ AbortPtr^ := False;
+ {$ENDIF ~FPC}
+ PipeBytesRead := 0;
+ while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
+ ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ if (AbortPtr <> nil) and LongBool(AbortPtr^) then
+ TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
+ if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
+ not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
+ Result := $FFFFFFFF;
+ CloseHandle(ProcessInfo.hThread);
+ ProcessInfo.hThread := 0;
+ CloseHandle(ProcessInfo.hProcess);
+ ProcessInfo.hProcess := 0;
+ end
+ else
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ end;
+ CloseHandle(PipeRead);
+ PipeRead := 0;
+ finally
+ if PipeRead <> 0 then
+ CloseHandle(PipeRead);
+ if PipeWrite <> 0 then
+ CloseHandle(PipeWrite);
+ if ProcessInfo.hThread <> 0 then
+ CloseHandle(ProcessInfo.hThread);
+ if ProcessInfo.hProcess <> 0 then
+ begin
TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
- if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
- not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
- Result := $FFFFFFFF;
- CloseHandle(ProcessInfo.hThread);
- CloseHandle(ProcessInfo.hProcess);
- end
- else
- CloseHandle(PipeWrite);
- CloseHandle(PipeRead);
+ WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
+ GetExitCodeProcess(ProcessInfo.hProcess, Result);
+ CloseHandle(ProcessInfo.hProcess);
+ end;
+ end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
@@ -2626,26 +2653,34 @@
Cmd: string;
begin
Cmd := Format('%s 2>&1', [CommandLine]);
- Pipe := Libc.popen(PChar(Cmd), 'r');
- { TODO : handle Abort }
- repeat
- PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
- if PipeBytesRead > 0 then
- ProcessBuffer;
- until PipeBytesRead = 0;
- Result := pclose(Pipe);
- wait(nil);
+ Pipe := nil;
+ try
+ Pipe := Libc.popen(PChar(Cmd), 'r');
+ { TODO : handle Abort }
+ repeat
+ PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
+ if PipeBytesRead > 0 then
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ until PipeBytesRead = 0;
+ Result := pclose(Pipe);
+ Pipe := nil;
+ wait(nil);
+ finally
+ if Pipe <> nil then
+ pclose(Pipe);
+ wait(nil);
+ end;
{$ENDIF UNIX}
- if TempOutput <> '' then
+ if Line <> '' then
if Assigned(OutputLineCallback) then
// output wasn't terminated by a line feed...
// (shouldn't happen, but you never know)
- ProcessLine(Length(TempOutput))
+ ProcessLine(Line, Length(Line))
else
if RawOutput then
- Output := Output + TempOutput
+ Output := Output + Line
else
- Output := Output + MuteCRTerminatedLines(TempOutput);
+ Output := Output + MuteCRTerminatedLines(Line);
end;
{ TODO -cHelp :
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 16:27:26
|
Revision: 2927
http://jcl.svn.sourceforge.net/jcl/?rev=2927&view=rev
Author: outchy
Date: 2009-08-09 16:27:13 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
style cleanup.
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 15:07:06 UTC (rev 2926)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 16:27:13 UTC (rev 2927)
@@ -2084,13 +2084,13 @@
function StrOemToAnsi(const S: AnsiString): AnsiString;
begin
SetLength(Result, Length(S));
- OemToAnsiBuff(@S[1], @Result[1], Length(S));
+ OemToAnsiBuff(PAnsiChar(S), PAnsiChar(Result), Length(S));
end;
function StrAnsiToOem(const S: AnsiString): AnsiString;
begin
SetLength(Result, Length(S));
- AnsiToOemBuff(@S[1], @Result[1], Length(S));
+ AnsiToOemBuff(PAnsiChar(S), PAnsiChar(Result), Length(S));
end;
{$ENDIF MSWINDOWS}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 15:07:17
|
Revision: 2926
http://jcl.svn.sourceforge.net/jcl/?rev=2926&view=rev
Author: outchy
Date: 2009-08-09 15:07:06 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
fix incorrect output directory (one level too high).
Modified Paths:
--------------
trunk/jcl/experts/debug/simdview/JclSIMDTestDelphi.dof
Modified: trunk/jcl/experts/debug/simdview/JclSIMDTestDelphi.dof
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDTestDelphi.dof 2009-08-09 14:46:49 UTC (rev 2925)
+++ trunk/jcl/experts/debug/simdview/JclSIMDTestDelphi.dof 2009-08-09 15:07:06 UTC (rev 2926)
@@ -1,2 +1,2 @@
[Directories]
-OutputDir=..\..\..\..\bin
+OutputDir=..\..\..\bin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 14:46:56
|
Revision: 2925
http://jcl.svn.sourceforge.net/jcl/?rev=2925&view=rev
Author: outchy
Date: 2009-08-09 14:46:49 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
for now, always assume the assembler code availability.
Modified Paths:
--------------
trunk/jcl/source/common/JclMath.pas
Modified: trunk/jcl/source/common/JclMath.pas
===================================================================
--- trunk/jcl/source/common/JclMath.pas 2009-08-09 14:45:38 UTC (rev 2924)
+++ trunk/jcl/source/common/JclMath.pas 2009-08-09 14:46:49 UTC (rev 2925)
@@ -154,9 +154,7 @@
{$ENDIF SUPPORTS_EXTENDED}
function DegToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function DegToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastDegToRad;
-{$ENDIF CPUASM}
// Converts radians to degrees.
{$IFDEF SUPPORTS_EXTENDED}
@@ -164,9 +162,7 @@
{$ENDIF SUPPORTS_EXTENDED}
function RadToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function RadToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastRadToDeg;
-{$ENDIF CPUASM}
// Converts grads to radians.
{$IFDEF SUPPORTS_EXTENDED}
@@ -174,9 +170,7 @@
{$ENDIF SUPPORTS_EXTENDED}
function GradToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function GradToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastGradToRad;
-{$ENDIF CPUASM}
// Converts radians to grads.
{$IFDEF SUPPORTS_EXTENDED}
@@ -184,9 +178,7 @@
{$ENDIF SUPPORTS_EXTENDED}
function RadToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function RadToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastRadToGrad;
-{$ENDIF CPUASM}
// Converts degrees to grads.
{$IFDEF SUPPORTS_EXTENDED}
@@ -194,9 +186,7 @@
{$ENDIF SUPPORTS_EXTENDED}
function DegToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function DegToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastDegToGrad;
-{$ENDIF CPUASM}
// Converts grads to degrees.
{$IFDEF SUPPORTS_EXTENDED}
@@ -204,12 +194,8 @@
{$ENDIF SUPPORTS_EXTENDED}
function GradToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function GradToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
-{$IFDEF CPUASM}
procedure FastGradToDeg;
-{$ENDIF CPUASM}
-{$IFDEF CPUASM}
-
{ Logarithmic }
function LogBase10(X: Float): Float;
@@ -252,8 +238,6 @@
function SinH(X: Float): Float; overload; {IFDEF SUPPORTS_INLINE inline; ENDIF}
function TanH(X: Float): Float; overload;
-{$ENDIF CPUASM}
-
{ Coordinate conversion }
function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete (see JclUnitConv)
@@ -320,11 +304,8 @@
var
IsPrime: function(N: Cardinal): Boolean = IsPrimeTD;
-{$IFDEF CPUASM}
procedure SetPrimalityTest(const Method: TPrimalityTestMethod);
-{$ENDIF CPUASM}
-{$IFDEF CPUASM}
{ Floating point value classification }
type
@@ -344,7 +325,6 @@
{$IFDEF SUPPORTS_EXTENDED}
function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload;
{$ENDIF SUPPORTS_EXTENDED}
-{$ENDIF CPUASM}
{ NaN and INF support }
@@ -808,9 +788,7 @@
Windows,
{$ENDIF ~FPC}
{$ENDIF MSWINDOWS}
- {$IFDEF CPUASM}
Jcl8087,
- {$ENDIF CPUASM}
JclResources,
JclSynch;
@@ -897,7 +875,6 @@
Result := Value * RatioDegToRad;
end;
-{$IFDEF CPUASM}
// Expects degrees in ST(0), leaves radians in ST(0)
// ST(0) := ST(0) * PI / 180
procedure FastDegToRad; assembler;
@@ -916,7 +893,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
// Converts radians to degrees.
@@ -937,7 +913,6 @@
Result := Value * RatioRadToDeg;
end;
-{$IFDEF CPUASM}
// Expects radians in ST(0), leaves degrees in ST(0)
// ST(0) := ST(0) * (180 / PI);
procedure FastRadToDeg; assembler;
@@ -956,7 +931,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
// Converts grads to radians.
@@ -977,7 +951,6 @@
Result := Value * RatioGradToRad;
end;
-{$IFDEF CPUASM}
// Expects grads in ST(0), leaves radians in ST(0)
// ST(0) := ST(0) * PI / 200
procedure FastGradToRad; assembler;
@@ -996,7 +969,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
// Converts radians to grads.
@@ -1017,7 +989,6 @@
Result := Value * RatioRadToGrad;
end;
-{$IFDEF CPUASM}
// Expects radians in ST(0), leaves grads in ST(0)
// ST(0) := ST(0) * (200 / PI);
procedure FastRadToGrad; assembler;
@@ -1036,7 +1007,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
// Converts degrees to grads.
@@ -1057,7 +1027,6 @@
Result := Value * RatioDegToGrad;
end;
-{$IFDEF CPUASM}
// Expects Degrees in ST(0), leaves grads in ST(0)
// ST(0) := ST(0) * (200 / 180);
procedure FastDegToGrad; assembler;
@@ -1076,7 +1045,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
// Converts grads to degrees.
@@ -1097,7 +1065,6 @@
Result := Value * RatioGradToDeg;
end;
-{$IFDEF CPUASM}
// Expects grads in ST(0), leaves radians in ST(0)
// ST(0) := ST(0) * PI / 200
procedure FastGradToDeg; assembler;
@@ -1116,7 +1083,6 @@
FMULP
FWAIT
end;
-{$ENDIF CPUASM}
procedure DomainCheck(Err: Boolean);
begin
@@ -1126,7 +1092,6 @@
//=== Logarithmic ============================================================
-{$IFDEF CPUASM}
function LogBase10(X: Float): Float;
begin
DomainCheck(X <= 0.0);
@@ -1599,8 +1564,6 @@
end;
end;
-{$ENDIF CPUASM}
-
//=== Coordinate conversion ==================================================
function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete
@@ -2720,7 +2683,6 @@
end;
end;
-{$IFDEF CPUASM}
//=== Floating point value classification ====================================
const
@@ -2831,7 +2793,6 @@
end;
end;
{$ENDIF SUPPORTS_EXTENDED}
-{$ENDIF CPUASM}
//=== NaN and Infinity support ===============================================
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 14:45:45
|
Revision: 2924
http://jcl.svn.sourceforge.net/jcl/?rev=2924&view=rev
Author: outchy
Date: 2009-08-09 14:45:38 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
64 bit compatibility.
Modified Paths:
--------------
trunk/jcl/source/common/JclRTTI.pas
Modified: trunk/jcl/source/common/JclRTTI.pas
===================================================================
--- trunk/jcl/source/common/JclRTTI.pas 2009-08-09 14:39:32 UTC (rev 2923)
+++ trunk/jcl/source/common/JclRTTI.pas 2009-08-09 14:45:38 UTC (rev 2924)
@@ -690,7 +690,7 @@
P := @TypeData.NameList;
while I >= 0 do
begin
- Inc(Integer(P), Length(P^) + 1);
+ Inc(TJclAddr(P), Length(P^) + 1);
Dec(I);
end;
Result := string(P^);
@@ -1702,7 +1702,7 @@
PropData: ^TPropData;
begin
PropData := @TypeData.IntfUnit;
- Inc(Integer(PropData), 1 + Length(GetUnitName));
+ Inc(TJclAddr(PropData), 1 + Length(GetUnitName));
Result := PropData.PropCount;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 14:39:39
|
Revision: 2923
http://jcl.svn.sourceforge.net/jcl/?rev=2923&view=rev
Author: outchy
Date: 2009-08-09 14:39:32 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
C5 and D5 support removal: RTL140_UP is always defined.
Modified Paths:
--------------
trunk/jcl/source/common/JclWideStrings.pas
trunk/jcl/source/prototypes/JclAlgorithms.pas
Modified: trunk/jcl/source/common/JclWideStrings.pas
===================================================================
--- trunk/jcl/source/common/JclWideStrings.pas 2009-08-09 14:37:14 UTC (rev 2922)
+++ trunk/jcl/source/common/JclWideStrings.pas 2009-08-09 14:39:32 UTC (rev 2923)
@@ -32,7 +32,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -1355,10 +1355,8 @@
{$IFDEF RTL150_UP}
FNameValueSeparator := CharToWideChar(TStrings(Source).NameValueSeparator);
{$ENDIF RTL150_UP}
- {$IFDEF RTL140_UP}
FQuoteChar := CharToWideChar(TStrings(Source).QuoteChar);
FDelimiter := CharToWideChar(TStrings(Source).Delimiter);
- {$ENDIF RTL140_UP}
{$ENDIF ~RTL190_UP}
AddStrings(TStrings(Source));
finally
@@ -1386,10 +1384,8 @@
{$IFDEF RTL150_UP}
TStrings(Dest).NameValueSeparator := WideCharToChar(NameValueSeparator);
{$ENDIF RTL150_UP}
- {$IFDEF RTL140_UP}
TStrings(Dest).QuoteChar := WideCharToChar(QuoteChar);
TStrings(Dest).Delimiter := WideCharToChar(Delimiter);
- {$ENDIF RTL140_UP}
{$ENDIF ~RTL190_UP}
for I := 0 to Count - 1 do
TStrings(Dest).AddObject(GetP(I)^, Objects[I]);
Modified: trunk/jcl/source/prototypes/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/prototypes/JclAlgorithms.pas 2009-08-09 14:37:14 UTC (rev 2922)
+++ trunk/jcl/source/prototypes/JclAlgorithms.pas 2009-08-09 14:39:32 UTC (rev 2923)
@@ -305,9 +305,6 @@
{$IFDEF HAS_UNIT_ANSISTRINGS}
AnsiStrings,
{$ENDIF HAS_UNIT_ANSISTRINGS}
- {$IFNDEF RTL140_UP}
- JclWideStrings,
- {$ENDIF ~RTL140_UP}
SysUtils;
function IntfSimpleCompare(const Obj1, Obj2: IInterface): Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 14:37:23
|
Revision: 2922
http://jcl.svn.sourceforge.net/jcl/?rev=2922&view=rev
Author: outchy
Date: 2009-08-09 14:37:14 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
C5 and D5 support removal: RTL140_UP is always defined.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/favfolders/OpenDlgFavAdapter.pas
trunk/jcl/source/common/JclAlgorithms.pas
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclBorlandTools.pas
trunk/jcl/source/common/JclFileUtils.pas
trunk/jcl/source/common/JclRTTI.pas
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/common/JclSchedule.pas
trunk/jcl/source/windows/JclCIL.pas
trunk/jcl/source/windows/JclCLR.pas
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -968,7 +968,6 @@
ProjectFileName := Project.FileName;
OutputDirectory := GetOutputDirectory(Project);
- {$IFDEF RTL140_UP}
if not Assigned(Project.ProjectOptions) then
raise EJclExpertException.CreateTrace(RsENoProjectOptions);
LibPrefix := Trim(VarToStr(Project.ProjectOptions.Values[LIBPREFIXOptionName]));
@@ -977,10 +976,6 @@
LibPrefix := '';
if LibSuffix = 'false' then
LibSuffix := '';
- {$ELSE ~RTL140_UP}
- LibPrefix := '';
- LibSuffix := '';
- {$ENDIF ~RTL140_UP}
Result := PathAddSeparator(OutputDirectory) + LibPrefix +
PathExtractFileNameNoExt(ProjectFileName) + LibSuffix + CompilerExtensionMAP;
end;
Modified: trunk/jcl/experts/favfolders/OpenDlgFavAdapter.pas
===================================================================
--- trunk/jcl/experts/favfolders/OpenDlgFavAdapter.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/experts/favfolders/OpenDlgFavAdapter.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -109,9 +109,6 @@
implementation
uses
- {$IFNDEF RTL140_UP}
- Forms,
- {$ENDIF ~RTL140_UP}
CommDlg, Dlgs,
JclBase, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils,
JclOtaConsts, JclOtaResources, JclOtaUtils;
Modified: trunk/jcl/source/common/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/common/JclAlgorithms.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclAlgorithms.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -373,9 +373,6 @@
{$IFDEF HAS_UNIT_ANSISTRINGS}
AnsiStrings,
{$ENDIF HAS_UNIT_ANSISTRINGS}
- {$IFNDEF RTL140_UP}
- JclWideStrings,
- {$ENDIF ~RTL140_UP}
SysUtils;
function IntfSimpleCompare(const Obj1, Obj2: IInterface): Integer;
Modified: trunk/jcl/source/common/JclBase.pas
===================================================================
--- trunk/jcl/source/common/JclBase.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclBase.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -30,7 +30,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -94,7 +94,6 @@
{$ENDIF CPU64}
PSizeInt = ^SizeInt;
PPointer = ^Pointer;
- {$IFDEF RTL140_UP}
PByte = System.PByte;
Int8 = ShortInt;
Int16 = Smallint;
@@ -102,10 +101,6 @@
UInt8 = Byte;
UInt16 = Word;
UInt32 = LongWord;
- {$ELSE ~RTL140_UP}
- PBoolean = ^Boolean;
- PByte = Windows.PByte;
- {$ENDIF ~RTL140_UP}
PCardinal = ^Cardinal;
{$IFNDEF COMPILER7_UP}
UInt64 = Int64;
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -907,10 +907,6 @@
const
{$IFDEF MSWINDOWS}
- {$IFNDEF RTL140_UP}
- PathSep = ';';
- {$ENDIF ~RTL140_UP}
-
MSHelpSystemKeyName = '\SOFTWARE\Microsoft\Windows\Help';
BCBKeyName = '\SOFTWARE\Borland\C++Builder';
Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclFileUtils.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -1060,12 +1060,6 @@
is about the only routine which doesn't cause the file's last modification/accessed time to be
changed which is usually an undesired side-effect. }
-{$IFNDEF RTL140_UP}
-const
- MinDateTime: TDateTime = -657434.0; { 0100-01-01T00:00:00.000 }
- MaxDateTime: TDateTime = 2958465.99999; { 9999-12-31T23:59:59.999 }
-{$ENDIF ~RTL140_UP}
-
{$IFDEF UNIX}
const
ERROR_NO_MORE_FILES = -1;
Modified: trunk/jcl/source/common/JclRTTI.pas
===================================================================
--- trunk/jcl/source/common/JclRTTI.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclRTTI.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -147,17 +147,13 @@
['{7DAD5223-46EA-11D5-B0C0-4854E825F345}']
function GetBaseType: IJclEnumerationTypeInfo;
function GetNames(const I: Integer): string;
- {$IFDEF RTL140_UP}
function GetUnitName: string;
- {$ENDIF RTL140_UP}
function IndexOfName(const Name: string): Integer;
property BaseType: IJclEnumerationTypeInfo read GetBaseType;
property Names[const I: Integer]: string read GetNames; default;
- {$IFDEF RTL140_UP}
property UnitName: string read GetUnitName;
- {$ENDIF RTL140_UP}
end;
IJclSetTypeInfo = interface(IJclOrdinalTypeInfo)
@@ -283,17 +279,13 @@
function GetParent: IJclInterfaceTypeInfo;
function GetFlags: TIntfFlagsBase;
function GetGUID: TGUID;
- {$IFDEF RTL140_UP}
function GetPropertyCount: Integer;
- {$ENDIF RTL140_UP}
function GetUnitName: string;
property Parent: IJclInterfaceTypeInfo read GetParent;
property Flags: TIntfFlagsBase read GetFlags;
property GUID: TGUID read GetGUID;
- {$IFDEF RTL140_UP}
property PropertyCount: Integer read GetPropertyCount;
- {$ENDIF RTL140_UP}
property UnitName: string read GetUnitName;
end;
@@ -307,7 +299,6 @@
property MaxValue: Int64 read GetMaxValue;
end;
- {$IFDEF RTL140_UP}
// Dynamic array types
IJclDynArrayTypeInfo = interface(IJclTypeInfo)
['{7DAD522E-46EA-11D5-B0C0-4854E825F345}']
@@ -323,7 +314,6 @@
property VarType: Integer read GetVarType;
property UnitName: string read GetUnitName;
end;
- {$ENDIF RTL140_UP}
EJclRTTIError = class(EJclError);
@@ -655,9 +645,7 @@
protected
function GetBaseType: IJclEnumerationTypeInfo;
function GetNames(const I: Integer): string;
- {$IFDEF RTL140_UP}
function GetUnitName: string;
- {$ENDIF RTL140_UP}
function IndexOfName(const Name: string): Integer;
procedure WriteTo(const Dest: IJclInfoWriter); override;
procedure DeclarationTo(const Dest: IJclInfoWriter); override;
@@ -691,8 +679,6 @@
Result := string(P^);
end;
-{$IFDEF RTL140_UP}
-
function TJclEnumerationTypeInfo.GetUnitName: string;
var
I: Integer;
@@ -713,8 +699,6 @@
Result := string(TypeData.NameList);
end;
-{$ENDIF RTL140_UP}
-
function TJclEnumerationTypeInfo.IndexOfName(const Name: string): Integer;
begin
Result := MaxValue;
@@ -731,9 +715,7 @@
Prefix: string;
begin
inherited WriteTo(Dest);
- {$IFDEF RTL140_UP}
Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName);
- {$ENDIF RTL140_UP}
Dest.Write(LoadResString(@RsRTTINameList));
Prefix := '(';
for Idx := MinValue to MaxValue do
@@ -1680,9 +1662,7 @@
function GetParent: IJclInterfaceTypeInfo;
function GetFlags: TIntfFlagsBase;
function GetGUID: TGUID;
- {$IFDEF RTL140_UP}
function GetPropertyCount: Integer;
- {$ENDIF RTL140_UP}
function GetUnitName: string;
procedure WriteTo(const Dest: IJclInfoWriter); override;
procedure DeclarationTo(const Dest: IJclInfoWriter); override;
@@ -1690,9 +1670,7 @@
property Parent: IJclInterfaceTypeInfo read GetParent;
property Flags: TIntfFlagsBase read GetFlags;
property GUID: TGUID read GetGUID;
- {$IFDEF RTL140_UP}
property PropertyCount: Integer read GetPropertyCount;
- {$ENDIF RTL140_UP}
end;
function TJclInterfaceTypeInfo.GetParent: IJclInterfaceTypeInfo;
@@ -1719,7 +1697,6 @@
Result := NullGUID;
end;
-{$IFDEF RTL140_UP}
function TJclInterfaceTypeInfo.GetPropertyCount: Integer;
var
PropData: ^TPropData;
@@ -1728,7 +1705,6 @@
Inc(Integer(PropData), 1 + Length(GetUnitName));
Result := PropData.PropCount;
end;
-{$ENDIF RTL140_UP}
function TJclInterfaceTypeInfo.GetUnitName: string;
begin
@@ -1748,9 +1724,7 @@
Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName);
if Parent <> nil then
Dest.Writeln(LoadResString(@RsRTTIParent) + Parent.Name);
- {$IFDEF RTL140_UP}
Dest.Writeln(LoadResString(@RsRTTIPropCount) + IntToStr(PropertyCount));
- {$ENDIF RTL140_UP}
end;
procedure TJclInterfaceTypeInfo.DeclarationTo(const Dest: IJclInfoWriter);
@@ -1812,8 +1786,6 @@
//=== { TJclDynArrayTypeInfo } ===============================================
-{$IFDEF RTL140_UP}
-
type
TJclDynArrayTypeInfo = class(TJclTypeInfo, IJclDynArrayTypeInfo)
protected
@@ -1909,8 +1881,6 @@
Dest.Writeln('; // Unit ' + GetUnitName);
end;
-{$ENDIF RTL140_UP}
-
//=== Typeinfo retrieval =====================================================
function JclTypeInfo(ATypeInfo: PTypeInfo): IJclTypeInfo;
@@ -1934,10 +1904,8 @@
Result := TJclInterfaceTypeInfo.Create(ATypeInfo);
tkInt64:
Result := TJclInt64TypeInfo.Create(ATypeInfo);
- {$IFDEF RTL140_UP}
tkDynArray:
Result := TJclDynArrayTypeInfo.Create(ATypeInfo);
- {$ENDIF RTL140_UP}
else
Result := TJclTypeInfo.Create(ATypeInfo);
end;
@@ -2111,7 +2079,7 @@
StringSize := StringSize + 1 + Length(Literals[I]);
Result := AllocMem(SizeOf(TTypeInfo) + SizeOf(TOrdType) +
(2*SizeOf(Integer)) + SizeOf(PPTypeInfo) +
- StringSize {$IFDEF RTL140_UP}+ 1{$ENDIF RTL140_UP});
+ StringSize + 1);
try
with Result^ do
begin
@@ -2136,9 +2104,7 @@
CurName^ := ShortString(Literals[I]);
Inc(TJclAddr(CurName), Length(Literals[I])+1);
end;
- {$IFDEF RTL140_UP}
CurName^ := ''; // Unit name unknown
- {$ENDIF RTL140_UP}
AddType(Result);
except
try
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclResources.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -55,11 +55,6 @@
JclUnitVersioning;
{$ENDIF UNITVERSIONING}
-{$IFNDEF RTL140_UP}
-const
- sLineBreak = #13#10;
-{$ENDIF ~RTL140_UP}
-
//=== JclBase ================================================================
resourcestring
RsWin32Prefix = 'Win32: %s (%u)';
Modified: trunk/jcl/source/common/JclSchedule.pas
===================================================================
--- trunk/jcl/source/common/JclSchedule.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/common/JclSchedule.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -194,71 +194,6 @@
uses
JclDateTime, JclResources;
-{$IFNDEF RTL140_UP}
-{$IFNDEF FPC}
-
-const
- S_OK = $00000000;
- E_NOINTERFACE = HRESULT($80004002);
-
-type
- TAggregatedObject = class
- private
- FController: Pointer;
- function GetController: IUnknown;
- protected
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- public
- constructor Create(Controller: IUnknown);
- property Controller: IUnknown read GetController;
- end;
-
- TContainedObject = class(TAggregatedObject, IUnknown)
- protected
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
- end;
-
-//=== { TAggregatedObject } ==================================================
-
-constructor TAggregatedObject.Create(Controller: IUnknown);
-begin
- FController := Pointer(Controller);
-end;
-
-function TAggregatedObject.GetController: IUnknown;
-begin
- Result := IUnknown(FController);
-end;
-
-function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
-begin
- Result := IUnknown(FController).QueryInterface(IID, Obj);
-end;
-
-function TAggregatedObject._AddRef: Integer;
-begin
- Result := IUnknown(FController)._AddRef;
-end;
-
-function TAggregatedObject._Release: Integer; stdcall;
-begin
- Result := IUnknown(FController)._Release;
-end;
-
-//=== { TContainedObject } ===================================================
-
-function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
-begin
- if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
-end;
-
-{$ENDIF ~FPC}
-{$ENDIF ~RTL140_UP}
-
//=== { TScheduleAggregate } =================================================
type
Modified: trunk/jcl/source/windows/JclCIL.pas
===================================================================
--- trunk/jcl/source/windows/JclCIL.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/windows/JclCIL.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -221,10 +221,8 @@
{$IFDEF HAS_UNIT_VARIANTS}
Variants,
{$ENDIF HAS_UNIT_VARIANTS}
- {$IFDEF RTL140_UP}
JclCLR,
JclPeImage,
- {$ENDIF RTL140_UP}
JclStrings, JclResources;
type
@@ -808,7 +806,6 @@
FParam[I] := Value;
end;
end;
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
ptSOff, ptI1:
begin
Stream.Read(VShortInt, SizeOf(ShortInt));
@@ -829,7 +826,6 @@
Stream.Read(VInt64, SizeOf(Int64));
VType := varInt64;
end;
- {$ENDIF RTL140_UP}
end;
except
Stream.Position := FOffset;
@@ -840,10 +836,8 @@
procedure TJclInstruction.Save(Stream: TStream);
var
Code: Byte;
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
ArraySize: DWORD;
I, Value: Integer;
- {$ENDIF RTL140_UP}
begin
if WideOpCode then
begin
@@ -865,7 +859,6 @@
Stream.Write(TVarData(FParam).VSingle, SizeOf(Single));
ptR8:
Stream.Write(TVarData(FParam).VDouble, SizeOf(Double));
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
ptSOff, ptI1:
Stream.Write(TVarData(FParam).VShortInt, SizeOf(ShortInt));
ptU2:
@@ -885,7 +878,6 @@
Stream.Write(Value, SizeOf(Value));
end;
end;
- {$ENDIF RTL140_UP}
end;
end;
@@ -916,10 +908,8 @@
end;
var
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
I: Integer;
Row: TJclClrTableRow;
- {$ENDIF RTL140_UP}
CodeStr, ParamStr: string;
begin
case Option of
@@ -938,7 +928,6 @@
ParamStr := IntToHex(TVarData(FParam).VByte, 2);
ptArray:
ParamStr := 'Array';
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
ptI2, ptU2:
ParamStr := IntToHex(TVarData(FParam).VWord, 4);
ptLOff, ptI4, ptU4, ptR4:
@@ -947,7 +936,6 @@
ParamStr := IntToHex(TVarData(FParam).VInt64, 16);
ptToken:
ParamStr := TokenToString(TVarData(FParam).VLongWord);
- {$ENDIF RTL140_UP}
else
ParamStr := '';
end;
@@ -961,7 +949,6 @@
; // do nothing
ptLOff:
Result := FormatLabel(Integer(Offset) + + Integer(Size) + TVarData(Param).VInteger - 1);
- {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? }
ptToken:
begin
if Byte(TJclPeMetadata.TokenTable(TVarData(Param).VLongWord)) = $70 then
@@ -1009,7 +996,6 @@
end;
Result := ' (' + Result + ')';
end;
- {$ENDIF RTL140_UP}
else
Result := VarToStr(Param);
end;
Modified: trunk/jcl/source/windows/JclCLR.pas
===================================================================
--- trunk/jcl/source/windows/JclCLR.pas 2009-08-09 13:08:29 UTC (rev 2921)
+++ trunk/jcl/source/windows/JclCLR.pas 2009-08-09 14:37:14 UTC (rev 2922)
@@ -27,7 +27,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -1106,11 +1106,7 @@
I: Integer;
begin
Result := '// Dump ' + ClassName + NativeLineBreak;
- {$IFDEF RTL140_UP}
if Supports(ClassType, ITableCanDumpIL) then
- {$ELSE RTL140_UP}
- if ClassType.GetInterfaceEntry(ITableCanDumpIL) <> nil then
- {$ENDIF RTL140_UP}
for I := 0 to FRows.Count - 1 do
Result := Result + TJclClrTableRow(FRows[I]).DumpIL;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 13:08:52
|
Revision: 2921
http://jcl.svn.sourceforge.net/jcl/?rev=2921&view=rev
Author: outchy
Date: 2009-08-09 13:08:29 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
First compatibility patches for 64-bit runtime (basic tests done with FPC 2.2.4):
- some assembler code removal to keep things as simple as possible;
- deletion of the redundant Str* functions from JclUnicode.pas (the ones in JclWideStrings.pas have the same behavior);
- new SizeInt and PSizeInt types to store the sizes of strings, arrays...
- string related functions (JclStrings.pas, JclAnsiStrings.pas, JclWideStrings.pas and JclStringConversions.pas) now use SizeInt to store character positions;
- the extended floating point data type is not supported on Windows 64 --> extended specific code is trapped inside compiler conditional defines;
- JclDebug small rewrite: GetThreadSelectorEntry is not available on Win64 --> use NtQueryInformationThread instead;
- rewriting of all Win32 API stub (JclWin32, HardLinks, JclDotNet...) to be compatible with Win32 (resp. Win64) calling conventions: stdcall (fastcall);
- new functions in JclLogic.pas and JclSynch.pas to handle 64 bit data;
- unit WinSysUt is not available on Win64.
Modified Paths:
--------------
trunk/jcl/source/common/Jcl8087.pas
trunk/jcl/source/common/JclAnsiStrings.pas
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclDateTime.pas
trunk/jcl/source/common/JclExprEval.pas
trunk/jcl/source/common/JclFileUtils.pas
trunk/jcl/source/common/JclLogic.pas
trunk/jcl/source/common/JclMIDI.pas
trunk/jcl/source/common/JclMath.pas
trunk/jcl/source/common/JclMime.pas
trunk/jcl/source/common/JclPCRE.pas
trunk/jcl/source/common/JclRTTI.pas
trunk/jcl/source/common/JclStrHashMap.pas
trunk/jcl/source/common/JclStreams.pas
trunk/jcl/source/common/JclStringConversions.pas
trunk/jcl/source/common/JclStrings.pas
trunk/jcl/source/common/JclSynch.pas
trunk/jcl/source/common/JclSysInfo.pas
trunk/jcl/source/common/JclSysUtils.pas
trunk/jcl/source/common/JclUnicode.pas
trunk/jcl/source/common/JclWideStrings.pas
trunk/jcl/source/common/pcre.pas
trunk/jcl/source/common/zlibh.pas
trunk/jcl/source/prototypes/Hardlinks.pas
trunk/jcl/source/prototypes/JclWin32.pas
trunk/jcl/source/prototypes/_GraphUtils.pas
trunk/jcl/source/prototypes/_Graphics.pas
trunk/jcl/source/prototypes/win32api/AclApi.imp
trunk/jcl/source/prototypes/win32api/ImageHlp.imp
trunk/jcl/source/prototypes/win32api/ImageHlp.int
trunk/jcl/source/prototypes/win32api/LmAccess.imp
trunk/jcl/source/prototypes/win32api/LmApiBuf.imp
trunk/jcl/source/prototypes/win32api/Nb30.imp
trunk/jcl/source/prototypes/win32api/NtSecApi.imp
trunk/jcl/source/prototypes/win32api/ObjBase.imp
trunk/jcl/source/prototypes/win32api/ObjBase.int
trunk/jcl/source/prototypes/win32api/TlHelp32.imp
trunk/jcl/source/prototypes/win32api/WinBase.imp
trunk/jcl/source/prototypes/win32api/WinBase.int
trunk/jcl/source/prototypes/win32api/WinNLS.imp
trunk/jcl/source/prototypes/win32api/WinUser.imp
trunk/jcl/source/prototypes/win32api/powrprof.imp
trunk/jcl/source/vcl/JclGraphUtils.pas
trunk/jcl/source/vcl/JclGraphics.pas
trunk/jcl/source/windows/Hardlinks.pas
trunk/jcl/source/windows/JclAppInst.pas
trunk/jcl/source/windows/JclCIL.pas
trunk/jcl/source/windows/JclCLR.pas
trunk/jcl/source/windows/JclConsole.pas
trunk/jcl/source/windows/JclDebug.pas
trunk/jcl/source/windows/JclDotNet.pas
trunk/jcl/source/windows/JclHookExcept.pas
trunk/jcl/source/windows/JclLocales.pas
trunk/jcl/source/windows/JclMetadata.pas
trunk/jcl/source/windows/JclMultimedia.pas
trunk/jcl/source/windows/JclNTFS.pas
trunk/jcl/source/windows/JclPeImage.pas
trunk/jcl/source/windows/JclSecurity.pas
trunk/jcl/source/windows/JclSvcCtrl.pas
trunk/jcl/source/windows/JclTD32.pas
trunk/jcl/source/windows/JclWideFormat.pas
trunk/jcl/source/windows/JclWin32.pas
Added Paths:
-----------
trunk/jcl/source/prototypes/win32api/Winternl.imp
trunk/jcl/source/prototypes/win32api/Winternl.int
Modified: trunk/jcl/source/common/Jcl8087.pas
===================================================================
--- trunk/jcl/source/common/Jcl8087.pas 2009-08-09 09:36:43 UTC (rev 2920)
+++ trunk/jcl/source/common/Jcl8087.pas 2009-08-09 13:08:29 UTC (rev 2921)
@@ -94,18 +94,12 @@
const
X87ExceptBits = $3F;
-function Get8087ControlWord: Word; assembler;
-asm
- {$IFDEF CPU32}
- SUB ESP, $2
- FSTCW [ESP]
- {$ENDIF CPU32}
- {$IFDEF CPU64}
- SUB RSP, $2
- FSTCW [RSP]
- {$ENDIF CPU64}
- FWAIT
- POP AX
+function Get8087ControlWord: Word;
+begin
+ asm
+ FSTCW Result
+ FWAIT
+ end;
end;
function Get8087Infinity: T8087Infinity;
@@ -123,14 +117,16 @@
Result := T8087Rounding((Get8087ControlWord and $0C00) shr 10);
end;
-function Get8087StatusWord(ClearExceptions: Boolean): Word; assembler;
-asm
- TEST AX, AX // if ClearExceptions then
- JE @@NoClearExceptions
- FSTSW AX // get status word (clears exceptions)
- RET
-@@NoClearExceptions: // else
- FNSTSW AX // get status word (without clearing exceptions)
+function Get8087StatusWord(ClearExceptions: Boolean): Word;
+begin
+ if ClearExceptions then
+ asm
+ FSTSW Result // get status word (clears exceptions)
+ end
+ else
+ asm
+ FNSTSW Result // get status word (without clearing exceptions)
+ end;
end;
function Set8087Infinity(const Infinity: T8087Infinity): T8087Infinity;
@@ -160,83 +156,127 @@
Set8087ControlWord((CW and $F3FF) or (Word(Rounding) shl 10));
end;
-function Set8087ControlWord(const Control: Word): Word; assembler;
-asm
- FNCLEX
- {$IFDEF CPU32}
- SUB ESP, $2
- FSTCW [ESP]
- XCHG [ESP], AX
- FLDCW [ESP]
- ADD ESP, $2
- {$ENDIF CPU32}
- {$IFDEF CPU64}
- SUB RSP, $2
- FSTCW [RSP]
- XCHG [RSP], AX
- FLDCW [RSP]
- ADD RSP, $2
- {$ENDIF CPU64}
+function Set8087ControlWord(const Control: Word): Word;
+begin
+ asm
+ FNCLEX
+ FSTCW Result // save the old control word
+ FLDCW Control // load the new control word
+ end;
end;
function ClearPending8087Exceptions: T8087Exceptions;
-asm
- FNSTSW AX
- AND AX, X87ExceptBits
- FNCLEX
+var
+ SW: Word;
+begin
+ asm
+ FNSTSW SW
+ AND SW, X87ExceptBits
+ FNCLEX
+ end;
+ Result := [];
+ if (SW and $01) <> 0 then
+ Include(Result, emInvalidOp);
+ if (SW and $02) <> 0 then
+ Include(Result, emDenormalizedOperand);
+ if (SW and $04) <> 0 then
+ Include(Result, emZeroDivide);
+ if (SW and $08) <> 0 then
+ Include(Result, emOverflow);
+ if (SW and $10) <> 0 then
+ Include(Result, emUnderflow);
+ if (SW and $20) <> 0 then
+ Include(Result, emPrecision);
end;
function GetPending8087Exceptions: T8087Exceptions;
-asm
- FNSTSW AX
- AND AX, X87ExceptBits
+var
+ SW: Word;
+begin
+ asm
+ FNSTSW SW
+ AND SW, X87ExceptBits
+ end;
+ Result := [];
+ if (SW and $01) <> 0 then
+ Include(Result, emInvalidOp);
+ if (SW and $02) <> 0 then
+ Include(Result, emDenormalizedOperand);
+ if (SW and $04) <> 0 then
+ Include(Result, emZeroDivide);
+ if (SW and $08) <> 0 then
+ Include(Result, emOverflow);
+ if (SW and $10) <> 0 then
+ Include(Result, emUnderflow);
+ if (SW and $20) <> 0 then
+ Include(Result, emPrecision);
end;
function GetMasked8087Exceptions: T8087Exceptions;
-asm
- {$IFDEF CPU32}
- SUB ESP, $2
- FSTCW [ESP]
- {$ENDIF CPU32}
- {$IFDEF CPU64}
- SUB RSP, $2
- FSTCW [RSP]
- {$ENDIF CPU64}
- FWAIT
- POP AX
- AND AX, X87ExceptBits
+var
+ CW: Word;
+begin
+ asm
+ FSTCW CW
+ AND CW, X87ExceptBits
+ end;
+ Result := [];
+ if (CW and $01) <> 0 then
+ Include(Result, emInvalidOp);
+ if (CW and $02) <> 0 then
+ Include(Result, emDenormalizedOperand);
+ if (CW and $04) <> 0 then
+ Include(Result, emZeroDivide);
+ if (CW and $08) <> 0 then
+ Include(Result, emOverflow);
+ if (CW and $10) <> 0 then
+ Include(Result, emUnderflow);
+ if (CW and $20) <> 0 then
+ Include(Result, emPrecision);
end;
function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions;
-asm
- TEST DL, DL // if ClearBefore then
- JZ @1
+var
+ OldCW, NewCW: Word;
+begin
+ if ClearBefore then
+ asm
FNCLEX // clear pending exceptions
-@1:
- {$IFDEF CPU32}
- SUB ESP, $2
- FSTCW [ESP]
+ end;
+ NewCW := 0;
+ if emInvalidOp in Exceptions then
+ NewCW := NewCW or $01;
+ if emDenormalizedOperand in Exceptions then
+ NewCW := NewCW or $02;
+ if emZeroDivide in Exceptions then
+ NewCW := NewCW or $04;
+ if emOverflow in Exceptions then
+ NewCW := NewCW or $08;
+ if emUnderflow in Exceptions then
+ NewCW := NewCW or $10;
+ if emPrecision in Exceptions then
+ NewCW := NewCW or $20;
+ asm
+ FSTCW OldCW
FWAIT
- AND AX, X87ExceptBits // mask exception mask bits 0..5
- MOV DX, [ESP]
- AND WORD PTR [ESP], NOT X87ExceptBits
- OR [ESP], AX
- FLDCW [ESP]
- ADD ESP, $2
- {$ENDIF CPU32}
- {$IFDEF CPU64}
- SUB RSP, $2
- FSTCW [RSP]
- FWAIT
- AND AX, X87ExceptBits // mask exception mask bits 0..5
- MOV DX, [RSP]
- AND WORD PTR [RSP], NOT X87ExceptBits
- OR [RSP], AX
- FLDCW [RSP]
- ADD RSP, $2
- {$ENDIF CPU64}
- MOV AX, DX
- AND AX, X87ExceptBits
+ MOV AX, OldCW
+ AND AX, NOT X87ExceptBits // mask exception mask bits 0..5
+ OR NewCW, AX
+ FLDCW NewCW
+ end;
+ Result := [];
+ if (OldCW and $01) <> 0 then
+ Include(Result, emInvalidOp);
+ if (OldCW and $02) <> 0 then
+ Include(Result, emDenormalizedOperand);
+ if (OldCW and $04) <> 0 then
+ Include(Result, emZeroDivide);
+ if (OldCW and $08) <> 0 then
+ Include(Result, emOverflow);
+ if (OldCW and $10) <> 0 then
+ Include(Result, emUnderflow);
+ if (OldCW and $20) <> 0 then
+ Include(Result, emPrecision);
end;
function Mask8087Exceptions(Exceptions: T8087Exceptions): T8087Exceptions;
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 09:36:43 UTC (rev 2920)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-08-09 13:08:29 UTC (rev 2921)
@@ -303,9 +303,9 @@
function StrSame(const S1, S2: AnsiString): Boolean;
// String Transformation Routines
-function StrCenter(const S: AnsiString; L: Integer; C: AnsiChar = ' '): AnsiString;
-function StrCharPosLower(const S: AnsiString; CharPos: Integer): AnsiString;
-function StrCharPosUpper(const S: AnsiString; CharPos: Integer): AnsiString;
+function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString;
+function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString;
+function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString;
function StrDoubleQuote(const S: AnsiString): AnsiString;
function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString;
function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString;
@@ -316,9 +316,9 @@
procedure StrLowerInPlace(var S: AnsiString);
procedure StrLowerBuff(S: PAnsiChar);
procedure StrMove(var Dest: AnsiString; const Source: AnsiString; const ToIndex,
- FromIndex, Count: Integer);
-function StrPadLeft(const S: AnsiString; Len: Integer; C: AnsiChar = AnsiSpace): AnsiString;
-function StrPadRight(const S: AnsiString; Len: Integer; C: AnsiChar = AnsiSpace): AnsiString;
+ FromIndex, Count: SizeInt);
+function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString;
+function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString;
function StrProper(const S: AnsiString): AnsiString;
procedure StrProperBuff(S: PAnsiChar);
function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString;
@@ -328,8 +328,8 @@
function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString;
function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString;
function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString;
-function StrRepeat(const S: AnsiString; Count: Integer): AnsiString;
-function StrRepeatLength(const S: AnsiString; const L: Integer): AnsiString;
+function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString;
+function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString;
function StrReverse(const S: AnsiString): AnsiString;
procedure StrReverseInPlace(var S: AnsiString);
function StrSingleQuote(const S: AnsiString): AnsiString;
@@ -359,35 +359,36 @@
procedure StrResetLength(var S: AnsiString);
// String Search and Replace Routines
-function StrCharCount(const S: AnsiString; C: AnsiChar): Integer;
-function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): Integer;
-function StrStrCount(const S, SubS: AnsiString): Integer;
-function StrCompare(const S1, S2: AnsiString): Integer;
-function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer;
-function StrRepeatChar(C: AnsiChar; Count: Integer): AnsiString;
-function StrFind(const Substr, S: AnsiString; const Index: Integer = 1): Integer;
+function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt;
+function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt;
+function StrStrCount(const S, SubS: AnsiString): SizeInt;
+function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean = False): SizeInt;
+function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = False): SizeInt;
+function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = True): SizeInt;
+function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString;
+function StrFind(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt;
function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean;
-function StrIndex(const S: AnsiString; const List: array of AnsiString): Integer;
-function StrILastPos(const SubStr, S: AnsiString): Integer;
-function StrIPos(const SubStr, S: AnsiString): Integer;
+function StrIndex(const S: AnsiString; const List: array of AnsiString): SizeInt;
+function StrILastPos(const SubStr, S: AnsiString): SizeInt;
+function StrIPos(const SubStr, S: AnsiString): SizeInt;
function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean;
-function StrLastPos(const SubStr, S: AnsiString): Integer;
-function StrMatch(const Substr, S: AnsiString; const Index: Integer = 1): Integer;
-function StrMatches(const Substr, S: AnsiString; const Index: Integer = 1): Boolean;
-function StrNIPos(const S, SubStr: AnsiString; N: Integer): Integer;
-function StrNPos(const S, SubStr: AnsiString; N: Integer): Integer;
-function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): Integer;
-function StrSearch(const Substr, S: AnsiString; const Index: Integer = 1): Integer;
+function StrLastPos(const SubStr, S: AnsiString): SizeInt;
+function StrMatch(const Substr, S: AnsiString; Index: SizeInt = 1): SizeInt;
+function StrMatches(const Substr, S: AnsiString; const Index: SizeInt = 1): Boolean;
+function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt;
+function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt;
+function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt;
+function StrSearch(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt;
// String Extraction
function StrAfter(const SubStr, S: AnsiString): AnsiString;
function StrBefore(const SubStr, S: AnsiString): AnsiString;
function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString;
-function StrChopRight(const S: AnsiString; N: Integer): AnsiString;
-function StrLeft(const S: AnsiString; Count: Integer): AnsiString;
-function StrMid(const S: AnsiString; Start, Count: Integer): AnsiString;
-function StrRestOf(const S: AnsiString; N: Integer): AnsiString;
-function StrRight(const S: AnsiString; Count: Integer): AnsiString;
+function StrChopRight(const S: AnsiString; N: SizeInt): AnsiString;
+function StrLeft(const S: AnsiString; Count: SizeInt): AnsiString;
+function StrMid(const S: AnsiString; Start, Count: SizeInt): AnsiString;
+function StrRestOf(const S: AnsiString; N: SizeInt): AnsiString;
+function StrRight(const S: AnsiString; Count: SizeInt): AnsiString;
// Character Test Routines
function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
@@ -419,17 +420,17 @@
function CharToggleCase(const C: AnsiChar): AnsiChar;
// Character Search and Replace
-function CharPos(const S: AnsiString; const C: AnsiChar; const Index: Integer = 1): Integer;
-function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: Integer = 1): Integer;
-function CharIPos(const S: AnsiString; C: AnsiChar; const Index: Integer = 1): Integer;
-function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer;
+function CharPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt;
+function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt;
+function CharIPos(const S: AnsiString; C: AnsiChar; const Index: SizeInt = 1): SizeInt;
+function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): SizeInt;
// PCharVector
type
PAnsiCharVector = ^PAnsiChar;
function StringsToPCharVector(var Dest: PAnsiCharVector; const Source: TJclAnsiStrings): PAnsiCharVector;
-function PCharVectorCount(Source: PAnsiCharVector): Integer;
+function PCharVectorCount(Source: PAnsiCharVector): SizeInt;
procedure PCharVectorToStrings(const Dest: TJclAnsiStrings; Source: PAnsiCharVector);
procedure FreePCharVector(var Dest: PAnsiCharVector);
@@ -439,8 +440,8 @@
function StringsToMultiSz(var Dest: PAnsiMultiSz; const Source: TJclAnsiStrings): PAnsiMultiSz;
procedure MultiSzToStrings(const Dest: TJclAnsiStrings; const Source: PAnsiMultiSz);
-function MultiSzLength(const Source: PAnsiMultiSz): Integer;
-procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: Integer);
+function MultiSzLength(const Source: PAnsiMultiSz): SizeInt;
+procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt);
procedure FreeMultiSz(var Dest: PAnsiMultiSz);
function MultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz;
@@ -465,12 +466,12 @@
function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean;
function StrToFloatSafe(const S: AnsiString): Float;
function StrToIntSafe(const S: AnsiString): Integer;
-procedure StrNormIndex(const StrLen: Integer; var Index: Integer; var Count: Integer); overload;
+procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload;
function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload;
-function AnsiCompareNaturalStr(const S1, S2: AnsiString): Integer;
-function AnsiCompareNaturalText(const S1, S2: AnsiString): Integer;
+function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;
+function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;
// internal structures published to make function inlining working
const
@@ -508,19 +509,20 @@
RtlConsts,
{$ENDIF HAS_UNIT_RTLCONSTS}
{$ENDIF SUPPORTS_UNICODE}
- JclLogic, JclResources, JclStreams;
+ JclLogic, JclResources, JclStreams, JclSynch;
//=== Internal ===============================================================
type
TAnsiStrRec = packed record
- RefCount: Longint;
- Length: Longint;
+ RefCount: SizeInt;
+ Length: SizeInt;
end;
PAnsiStrRec = ^TAnsiStrRec;
const
AnsiStrRecSize = SizeOf(TAnsiStrRec); // size of the AnsiString header rec
+
procedure LoadCharTypes;
var
CurrChar: AnsiChar;
@@ -603,179 +605,37 @@
// Uppercases or Lowercases a give AnsiString depending on the
// passed offset. (UpOffset or LoOffset)
-procedure StrCase(var Str: AnsiString; const Offset: Integer); register; assembler;
-type
- TAnsiUniqueStringType = procedure (var S : AnsiString);
-const
- AnsiUniqueString: TAnsiUniqueStringType = UniqueString;
-asm
- // make sure that the string is not null
-
- TEST EAX, EAX
- JZ @@StrIsNull
-
- // create unique string if this one is ref-counted
-
- PUSH EDX
- CALL AnsiUniqueString
- POP EDX
-
- // make sure that the new string is not null
-
- TEST EAX, EAX
- JZ @@StrIsNull
-
- // get the length, and prepare the counter
-
- MOV ECX, [EAX - AnsiStrRecSize].TAnsiStrRec.Length
- DEC ECX
- JS @@StrIsNull
-
- // ebx will hold the case map, esi pointer to Str
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
-
- // load case map and prepare variables }
-
- {$IFDEF PIC}
- LEA EBX, [EBX][AnsiCaseMap + EDX]
- {$ELSE ~PIC}
- LEA EBX, [AnsiCaseMap + EDX]
- {$ENDIF ~PIC}
- MOV ESI, EAX
- XOR EDX, EDX
- XOR EAX, EAX
-
-@@NextChar:
- // get current char from the AnsiString
-
- MOV DL, [ESI]
-
- // get corresponding char from the case map
-
- MOV AL, [EBX + EDX]
-
- // store it back in the string
-
- MOV [ESI], AL
-
- // update the loop counter and check the end of stirng
-
- DEC ECX
- JL @@Done
-
- // do the same thing with next 3 chars
-
- MOV DL, [ESI + 1]
- MOV AL, [EBX + EDX]
- MOV [ESI + 1], AL
-
- DEC ECX
- JL @@Done
- MOV DL, [ESI + 2]
- MOV AL, [EBX+EDX]
- MOV [ESI + 2], AL
-
- DEC ECX
- JL @@Done
- MOV DL, [ESI + 3]
- MOV AL, [EBX + EDX]
- MOV [ESI + 3], AL
-
- // point AnsiString to next 4 chars
-
- ADD ESI, 4
-
- // update the loop counter and check the end of stirng
-
- DEC ECX
- JGE @@NextChar
-
-@@Done:
- POP EDI
- POP ESI
- POP EBX
-
-@@StrIsNull:
+procedure StrCase(var Str: AnsiString; const Offset: SizeInt);
+var
+ P: PAnsiChar;
+ I, L: SizeInt;
+begin
+ if Str <> '' then
+ begin
+ UniqueString(Str);
+ P := PAnsiChar(Str);
+ L := Length(Str);
+ for I := 1 to L do
+ begin
+ P^ := AnsiCaseMap[Offset + Ord(P^)];
+ Inc(P);
+ end;
+ end;
end;
// Internal utility function
// Uppercases or Lowercases a give null terminated string depending on the
// passed offset. (UpOffset or LoOffset)
-procedure StrCaseBuff(S: PAnsiChar; const Offset: Integer); register; assembler;
-asm
- // make sure the string is not null
-
- TEST EAX, EAX
- JZ @@StrIsNull
-
- // ebx will hold the case map, esi pointer to Str
-
- PUSH EBX
- PUSH ESI
-
- // load case map and prepare variables
-
- {$IFDEF PIC}
- LEA EBX, [EBX][AnsiCaseMap + EDX]
- {$ELSE ~PIC}
- LEA EBX, [AnsiCaseMap + EDX]
- {$ENDIF ~PIC}
- MOV ESI, EAX
- XOR EDX, EDX
- XOR EAX, EAX
-
-@@NextChar:
- // get current char from the string
-
- MOV DL, [ESI]
-
- // check for null char
-
- TEST DL, DL
- JZ @@Done
-
- // get corresponding char from the case map
-
- MOV AL, [EBX + EDX]
-
- // store it back in the string
-
- MOV [ESI], AL
-
- // do the same thing with next 3 chars
-
- MOV DL, [ESI + 1]
- TEST DL, DL
- JZ @@Done
- MOV AL, [EBX+EDX]
- MOV [ESI + 1], AL
-
- MOV DL, [ESI + 2]
- TEST DL, DL
- JZ @@Done
- MOV AL, [EBX+EDX]
- MOV [ESI + 2], AL
-
- MOV DL, [ESI + 3]
- TEST DL, DL
- JZ @@Done
- MOV AL, [EBX+EDX]
- MOV [ESI + 3], AL
-
- // point string to next 4 chars
-
- ADD ESI, 4
- JMP @@NextChar
-
-@@Done:
- POP ESI
- POP EBX
-
-@@StrIsNull:
+procedure StrCaseBuff(S: PAnsiChar; const Offset: SizeInt);
+begin
+ if (S <> nil) and (S^ <> #0) then
+ begin
+ repeat
+ S^ := AnsiCaseMap[Offset + Ord(S^)];
+ Inc(S);
+ until S^ = #0;
+ end;
end;
{$IFDEF SUPPORTS_UNICODE}
@@ -1316,7 +1176,7 @@
// String Test Routines
function StrIsAlpha(const S: AnsiString): Boolean;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S <> '';
for I := 1 to Length(S) do
@@ -1331,7 +1191,7 @@
function StrIsAlphaNum(const S: AnsiString): Boolean;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S <> '';
for I := 1 to Length(S) do
@@ -1346,7 +1206,7 @@
function StrConsistsofNumberChars(const S: AnsiString): Boolean;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S <> '';
for I := 1 to Length(S) do
@@ -1361,7 +1221,7 @@
function StrContainsChars(const S: AnsiString; Chars: TSysCharSet; CheckAll: Boolean): Boolean;
var
- I: Integer;
+ I: SizeInt;
C: AnsiChar;
begin
Result := Chars = [];
@@ -1395,7 +1255,7 @@
function StrIsAlphaNumUnderscore(const S: AnsiString): Boolean;
var
- I: Integer;
+ I: SizeInt;
C: AnsiChar;
begin
for i := 1 to Length(s) do
@@ -1414,7 +1274,7 @@
function StrIsDigit(const S: AnsiString): Boolean;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S <> '';
for I := 1 to Length(S) do
@@ -1429,7 +1289,7 @@
function StrIsSubset(const S: AnsiString; const ValidChars: TSysCharSet): Boolean;
var
- I: Integer;
+ I: SizeInt;
begin
for I := 1 to Length(S) do
begin
@@ -1450,7 +1310,7 @@
//=== String Transformation Routines =========================================
-function StrCenter(const S: AnsiString; L: Integer; C: AnsiChar = ' '): AnsiString;
+function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString;
begin
if Length(S) < L then
begin
@@ -1461,14 +1321,14 @@
Result := S;
end;
-function StrCharPosLower(const S: AnsiString; CharPos: Integer): AnsiString;
+function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString;
begin
Result := S;
if (CharPos > 0) and (CharPos <= Length(S)) then
Result[CharPos] := CharLower(Result[CharPos]);
end;
-function StrCharPosUpper(const S: AnsiString; CharPos: Integer): AnsiString;
+function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString;
begin
Result := S;
if (CharPos > 0) and (CharPos <= Length(S)) then
@@ -1482,7 +1342,7 @@
function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString;
var
- PrefixLen: Integer;
+ PrefixLen: SizeInt;
begin
PrefixLen := Length(Prefix);
if Copy(Text, 1, PrefixLen) = Prefix then
@@ -1493,8 +1353,8 @@
function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString;
var
- SuffixLen: Integer;
- StrLength: Integer;
+ SuffixLen: SizeInt;
+ StrLength: SizeInt;
begin
SuffixLen := Length(Suffix);
StrLength := Length(Text);
@@ -1506,7 +1366,7 @@
function StrEnsurePrefix(const Prefix, Text: AnsiString): AnsiString;
var
- PrefixLen: Integer;
+ PrefixLen: SizeInt;
begin
PrefixLen := Length(Prefix);
if Copy(Text, 1, PrefixLen) = Prefix then
@@ -1517,7 +1377,7 @@
function StrEnsureSuffix(const Suffix, Text: AnsiString): AnsiString;
var
- SuffixLen: Integer;
+ SuffixLen: SizeInt;
begin
SuffixLen := Length(Suffix);
if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then
@@ -1528,13 +1388,13 @@
function StrEscapedToString(const S: AnsiString): AnsiString;
var
- I, Len: Integer;
+ I, Len: SizeInt;
procedure HandleHexEscapeSeq;
const
HexDigits = AnsiString('0123456789abcdefABCDEF');
var
- Val, N: Integer;
+ Val, N: SizeInt;
begin
N := Pos(S[I + 1], HexDigits) - 1;
if N < 0 then
@@ -1570,7 +1430,7 @@
const
OctDigits = AnsiString('01234567');
var
- Val, N: Integer;
+ Val, N: SizeInt;
begin
// first digit
Val := Pos(S[I], OctDigits) - 1;
@@ -1669,7 +1529,7 @@
end;
procedure StrMove(var Dest: AnsiString; const Source: AnsiString;
- const ToIndex, FromIndex, Count: Integer);
+ const ToIndex, FromIndex, Count: SizeInt);
begin
// Check strings
if (Source = '') or (Length(Dest) = 0) then
@@ -1686,9 +1546,9 @@
Move(Source[FromIndex], Dest[ToIndex], Count);
end;
-function StrPadLeft(const S: AnsiString; Len: Integer; C: AnsiChar): AnsiString;
+function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString;
var
- L: Integer;
+ L: SizeInt;
begin
L := Length(S);
if L < Len then
@@ -1697,9 +1557,9 @@
Result := S;
end;
-function StrPadRight(const S: AnsiString; Len: Integer; C: AnsiChar): AnsiString;
+function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString;
var
- L: Integer;
+ L: SizeInt;
begin
L := Length(S);
if L < Len then
@@ -1726,7 +1586,7 @@
function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString;
var
- L: Integer;
+ L: SizeInt;
begin
L := Length(S);
Result := S;
@@ -1745,7 +1605,7 @@
function StrRemoveChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString;
var
Source, Dest: PAnsiChar;
- Index, Len: Integer;
+ Index, Len: SizeInt;
begin
Len := Length(S);
SetLength(Result, Len);
@@ -1767,7 +1627,7 @@
function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString;
var
Source, Dest: PAnsiChar;
- Index, Len: Integer;
+ Index, Len: SizeInt;
begin
Len := Length(S);
SetLength(Result, Len);
@@ -1786,9 +1646,9 @@
SetLength(Result, Dest - PAnsiChar(Result));
end;
-function StrRepeat(const S: AnsiString; Count: Integer): AnsiString;
+function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString;
var
- L: Integer;
+ L: SizeInt;
P: PAnsiChar;
begin
L := Length(S);
@@ -1805,10 +1665,10 @@
end;
end;
-function StrRepeatLength(const S: AnsiString; const L: Integer): AnsiString;
+function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString;
var
- Count: Integer;
- LenS: Integer;
+ Count: SizeInt;
+ LenS: SizeInt;
P: PAnsiChar;
begin
Result := '';
@@ -1840,11 +1700,11 @@
SourceMatchPtr: PAnsiChar; { pointers into S and Search when first character has }
SearchMatchPtr: PAnsiChar; { been matched and we're probing for a complete match }
ResultPtr: PAnsiChar; { pointer into Result of character being written }
- ResultIndex: Integer;
- SearchLength: Integer; { length of search string }
- ReplaceLength: Integer; { length of replace string }
- BufferLength: Integer; { length of temporary result buffer }
- ResultLength: Integer; { length of result string }
+ ResultIndex: SizeInt;
+ SearchLength: SizeInt; { length of search string }
+ ReplaceLength: SizeInt; { length of replace string }
+ BufferLength: SizeInt; { length of temporary result buffer }
+ ResultLength: SizeInt; { length of result string }
C: AnsiChar; { first character of search string }
IgnoreCase: Boolean;
begin
@@ -1964,7 +1824,7 @@
function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S;
for I := 1 to Length(S) do
@@ -1974,7 +1834,7 @@
function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S;
for I := 1 to Length(S) do
@@ -1985,7 +1845,7 @@
function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet;
Replace: AnsiChar): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
Result := S;
for I := 1 to Length(S) do
@@ -2025,7 +1885,7 @@
function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString;
var
Source, Dest: PAnsiChar;
- Index, Len: Integer;
+ Index, Len: SizeInt;
begin
Result := '';
if Delimiters = [] then
@@ -2056,7 +1916,7 @@
function StrStringToEscaped(const S: AnsiString): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
Result := '';
for I := 1 to Length(S) do
@@ -2083,7 +1943,7 @@
else
// Characters < ' ' are escaped with hex sequence
if S[I] < #32 then
- Result := Result + AnsiString(Format('\x%.2x', [Integer(S[I])]))
+ Result := Result + AnsiString(Format('\x%.2x', [SizeInt(S[I])]))
else
Result := Result + S[I];
end;
@@ -2092,7 +1952,7 @@
function StrStripNonNumberChars(const S: AnsiString): AnsiString;
var
- I: Integer;
+ I: SizeInt;
C: AnsiChar;
begin
Result := '';
@@ -2106,8 +1966,8 @@
function StrToHex(const Source: AnsiString): AnsiString;
var
- Index: Integer;
- C, L, N: Integer;
+ Index: SizeInt;
+ C, L, N: SizeInt;
BL, BH: Byte;
S: AnsiString;
begin
@@ -2137,7 +1997,7 @@
Result := '';
Exit;
end;
- Result[N] := AnsiChar((BH shl 4) + BL);
+ Result[N] := AnsiChar((Cardinal(BH) shl 4) or Cardinal(BL));
Inc(N);
end;
end;
@@ -2145,7 +2005,7 @@
function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString;
var
- I, L: Integer;
+ I, L: SizeInt;
begin
I := 1;
L := Length(S);
@@ -2156,7 +2016,7 @@
function StrTrimCharsLeft(const S: AnsiString; const Chars: TSysCharSet): AnsiString;
var
- I, L: Integer;
+ I, L: SizeInt;
begin
I := 1;
L := Length(S);
@@ -2167,7 +2027,7 @@
function StrTrimCharsRight(const S: AnsiString; const Chars: TSysCharSet): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
I := Length(S);
while (I >= 1) and (S[I] in Chars) do
@@ -2177,7 +2037,7 @@
function StrTrimCharRight(const S: AnsiString; C: AnsiChar): AnsiString;
var
- I: Integer;
+ I: SizeInt;
begin
I := Length(S);
while (I >= 1) and (S[I] = C) do
@@ -2188,7 +2048,7 @@
function StrTrimQuotes(const S: AnsiString): AnsiString;
var
First, Last: AnsiChar;
- L: Integer;
+ L: SizeInt;
begin
L := Length(S);
if L > 1 then
@@ -2247,7 +2107,7 @@
if P^.RefCount = -1 then
UniqueString(S)
else
- InterLockedIncrement(P^.RefCount);
+ LockedInc(P^.RefCount);
end;
end;
@@ -2268,7 +2128,7 @@
Pointer(S) := nil;
end;
else
- InterLockedDecrement(P^.RefCount);
+ LockedDec(P^.RefCount);
end;
end;
end;
@@ -2301,7 +2161,7 @@
procedure StrResetLength(var S: AnsiString);
var
- I: Integer;
+ I: SizeInt;
begin
for I := 1 to Length(S) do
if S[I] = #0 then
@@ -2313,9 +2173,9 @@
//=== String Search and Replace Routines =====================================
-function StrCharCount(const S: AnsiString; C: AnsiChar): Integer;
+function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt;
var
- I: Integer;
+ I: SizeInt;
begin
Result := 0;
for I := 1 to Length(S) do
@@ -2323,9 +2183,9 @@
Inc(Result);
end;
-function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): Integer;
+function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt;
var
- I: Integer;
+ I: SizeInt;
begin
Result := 0;
for I := 1 to Length(S) do
@@ -2333,9 +2193,9 @@
Inc(Result);
end;
-function StrStrCount(const S, SubS: AnsiString): Integer;
+function StrStrCount(const S, SubS: AnsiString): SizeInt;
var
- I: Integer;
+ I: SizeInt;
begin
Result := 0;
if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then
@@ -2358,426 +2218,137 @@
end;
end;
-{$IFDEF PIC}
-function _StrCompare(const S1, S2: AnsiString): Integer; forward;
-
-function StrCompare(const S1, S2: AnsiString): Integer;
+(*
+{ 1} Test(StrCompareRange('', '', 1, 5), 0);
+{ 2} Test(StrCompareRange('A', '', 1, 5), -1);
+{ 3} Test(StrCompareRange('AB', '', 1, 5), -1);
+{ 4} Test(StrCompareRange('ABC', '', 1, 5), -1);
+{ 5} Test(StrCompareRange('', 'A', 1, 5), -1);
+{ 6} Test(StrCompareRange('', 'AB', 1, 5), -1);
+{ 7} Test(StrCompareRange('', 'ABC', 1, 5), -1);
+{ 8} Test(StrCompareRange('A', 'a', 1, 5), -2);
+{ 9} Test(StrCompareRange('A', 'a', 1, 1), -32);
+{10} Test(StrCompareRange('aA', 'aB', 1, 1), 0);
+{11} Test(StrCompareRange('aA', 'aB', 1, 2), -1);
+{12} Test(StrCompareRange('aB', 'aA', 1, 2), 1);
+{13} Test(StrCompareRange('aA', 'aa', 1, 2), -32);
+{14} Test(StrCompareRange('aa', 'aA', 1, 2), 32);
+{15} Test(StrCompareRange('', '', 1, 0), 0);
+{16} Test(StrCompareRange('A', 'A', 1, 0), -2);
+{17} Test(StrCompareRange('Aa', 'A', 1, 0), -2);
+{18} Test(StrCompareRange('Aa', 'Aa', 1, 2), 0);
+{19} Test(StrCompareRange('Aa', 'A', 1, 2), 0);
+{20} Test(StrCompareRange('Ba', 'A', 1, 2), 1);
+*)
+function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt;
+var
+ Len1, Len2: SizeInt;
+ I: SizeInt;
+ C1, C2: AnsiChar;
begin
- Result := _StrCompare(S1, S2);
-end;
+ if Pointer(S1) = Pointer(S2) then
+ begin
+ if (Count <= 0) and (S1 <> '') then
+ Result := -2 // no work
+ else
+ Result := 0;
+ end
+ else
+ if (S1 = '') or (S2 = '') then
+ Result := -1 // null string
+ else
+ if Count <= 0 then
+ Result := -2 // no work
+ else
+ begin
+ Len1 := Length(S1);
+ Len2 := Length(S2);
-function _StrCompare(const S1, S2: AnsiString): Integer; assembler;
-{$ELSE ~PIC}
-function StrCompare(const S1, S2: AnsiString): Integer; assembler;
-{$ENDIF ~PIC}
-asm
- // check if pointers are equal
+ if (Index - 1) + Count > Len1 then
+ Result := -2
+ else
+ begin
+ if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it
+ Count := Len2 - (Index - 1);
- CMP EAX, EDX
- JE @@Equal
+ if CaseSensitive then
+ begin
+ for I := 0 to Count - 1 do
+ begin
+ C1 := S1[Index + I];
+ C2 := S2[Index + I];
+ if C1 <> C2 then
+ begin
+ Result := Ord(C1) - Ord(C2);
+ Exit;
+ end;
+ end;
+ end
+ else
+ begin
+ for I := 0 to Count - 1 do
+ begin
+ C1 := S1[Index + I];
+ C2 := S2[Index + I];
+ if C1 <> C2 then
+ begin
+ C1 := CharLower(C1);
+ C2 := CharLower(C2);
+ if C1 <> C2 then
+ begin
+ Result := Ord(C1) - Ord(C2);
+ Exit;
+ end;
+ end;
+ end;
+ end;
+ Result := 0;
+ end;
+ end;
+end;
- // if S1 is nil return - Length(S2)
-
- TEST EAX, EAX
- JZ @@Str1Null
-
- // if S2 is nil return Length(S1)
-
- TEST EDX, EDX
- JZ @@Str2Null
-
- // EBX will hold case map, ESI S1, EDI S2
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
-
- // move AnsiString pointers
-
- MOV ESI, EAX
- MOV EDI, EDX
-
- // get the length of strings
-
- MOV EAX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length
- MOV EDX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length
-
- // exit if Length(S1) <> Length(S2)
-
- CMP EAX, EDX
- JNE @@MissMatch
-
- // check the length just in case
-
- DEC EDX
- JS @@InvalidStr
-
- DEC EAX
- JS @@InvalidStr
-
- // load case map
-
- LEA EBX, AnsiCaseMap
-
- // make ECX our loop counter
-
- MOV ECX, EAX
-
- // clear working regs
-
- XOR EAX, EAX
- XOR EDX, EDX
-
- // get last chars
-
- MOV AL, [ESI+ECX]
- MOV DL, [EDI+ECX]
-
- // lower case them
-
- MOV AL, [EBX+EAX]
- MOV DL, [EBX+EDX]
-
- // compare them
-
- CMP AL, DL
- JNE @@MissMatch
-
- // if there was only 1 char then exit
-
- JECXZ @@Match
-
-@@NextChar:
- // case sensitive compare of strings
-
- REPE CMPSB
- JE @@Match
-
- // if there was a missmatch try case insensitive compare, get the chars
-
- MOV AL, [ESI-1]
- MOV DL, [EDI-1]
-
- // lowercase and compare them, if equal then continue
-
- MOV AL, [EBX+EAX]
- MOV DL, [EBX+EDX]
- CMP AL, DL
- JE @@NextChar
-
- // if we make it here then strings don't match, return the difference
-
-@@MissMatch:
- SUB EAX, EDX
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@Match:
- // match, return 0
-
- XOR EAX, EAX
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@InvalidStr:
- XOR EAX, EAX
- DEC EAX
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@Str1Null:
- // return = - Length(Str2);
-
- MOV EDX, [EDX-AnsiStrRecSize].TAnsiStrRec.Length
- SUB EAX, EDX
- RET
-
-@@Str2Null:
- // return = Length(Str2);
-
- MOV EAX, [EAX-AnsiStrRecSize].TAnsiStrRec.Length
- RET
-
-@@Equal:
- XOR EAX, EAX
+function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean): SizeInt;
+var
+ Len1, Len2: SizeInt;
+begin
+ if Pointer(S1) = Pointer(S2) then
+ Result := 0
+ else
+ begin
+ Len1 := Length(S1);
+ Len2 := Length(S2);
+ Result := Len1 - Len2;
+ if Result = 0 then
+ Result := StrCompareRangeEx(S1, S2, 1, Len1, CaseSensitive);
+ end;
end;
-function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer; assembler;
-asm
- TEST EAX, EAX
- JZ @@Str1Null
-
- TEST EDX, EDX
- JZ @@StrNull
-
- DEC ECX
- JS @@StrNull
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
-
- MOV EBX, Count
- DEC EBX
- JS @@NoWork
-
- MOV ESI, EAX
- MOV EDI, EDX
-
- MOV EDX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length
-
- // # of chars in S1 - (Index - 1)
- SUB EDX, ECX
- JLE @@NoWork
-
- // # of chars in S1 - (Count - 1)
- SUB EDX, EBX
- JLE @@NoWork
-
- // move to index'th char
- ADD ESI, ECX
-
- MOV ECX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length
- DEC ECX
- JS @@NoWork
-
- // if Length(S2) > Count then ECX := Count else ECX := Length(S2)
-
- CMP ECX, EBX
- JLE @@Skip1
- MOV ECX, EBX
-
-@@Skip1:
- XOR EAX, EAX
- XOR EDX, EDX
-
-@@Loop:
- MOV AL, [ESI]
- INC ESI
- MOV DL, [EDI]
- INC EDI
-
- CMP AL, DL
- JNE @@MisMatch
-
- DEC ECX
- JGE @@Loop
-
-@@Match:
- XOR EAX, EAX
- POP EDI
- POP ESI
- POP EBX
- JMP @@Exit
-
-@@MisMatch:
- SUB EAX, EDX
- POP EDI
- POP ESI
- POP EBX
- JMP @@Exit
-
-@@NoWork:
- MOV EAX, -2
- POP EDI
- POP ESI
- POP EBX
- JMP @@Exit
-
-@@Str1Null:
- MOV EAX, 0
- TEST EDX, EDX
- JZ @@Exit
-
-@@StrNull:
- MOV EAX, -1
-
-@@Exit:
+function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt;
+begin
+ Result := StrCompareRangeEx(S1, S2, Index, Count, CaseSensitive);
end;
-function StrRepeatChar(C: AnsiChar; Count: Integer): AnsiString;
+function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString;
begin
SetLength(Result, Count);
if Count > 0 then
FillChar(Result[1], Count, C);
end;
-function StrFind(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
-const
- SearchChar: Byte = 0;
- NumberOfChars: Integer = 0;
-asm
- // if SubStr = '' then Return := 0;
-
- TEST EAX, EAX
- JZ @@SubstrIsNull
-
- // if Str = '' then Return := 0;
-
- TEST EDX, EDX
- JZ @@StrIsNull
-
- // Index := Index - 1; if Index < 0 then Return := 0;
-
- DEC ECX
- JL @@IndexIsSmall
-
- // EBX will hold the case table, ESI pointer to Str, EDI pointer
- // to Substr and - # of chars in Substr to compare
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
-
- // set the string pointers
-
- MOV ESI, EDX
- MOV EDI, EAX
-
- // save the Index in EDX
-
- MOV EDX, ECX
-
- // temporary get the length of Substr and Str
-
- MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length
- MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length
-
- // save the address of Str to compute the result
-
- PUSH ESI
-
- // dec the length of Substr because the first char is brought out of it
-
- DEC EBX
- JS @@NotFound
-
- // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2
-
- SUB ECX, EBX
- JLE @@NotFound
-
- SUB ECX, EDX
- JLE @@NotFound
-
- // # of chars in Substr to compare
-
- MOV NumberOfChars, EBX
-
- // point Str to Index'th char
-
- ADD ESI, EDX
-
- // load case map into EBX, and clear EAX
-
- LEA EBX, AnsiCaseMap
- XOR EAX, EAX
- XOR EDX, EDX
-
- // bring the first char out of the Substr and point Substr to the next char
-
- MOV DL, [EDI]
- INC EDI
-
- // lower case it
-
- MOV DL, [EBX + EDX]
- MOV SearchChar, DL
-
- JMP @@Find
-
-@@FindNext:
-
- // update the loop counter and check the end of AnsiString.
- // if we reached the end, Substr was not found.
-
- DEC ECX
- JL @@NotFound
-
-@@Find:
-
- // get current char from the AnsiString, and point Str to the next one
-
- MOV AL, [ESI]
- INC ESI
-
-
- // lower case current char
-
- MOV AL, [EBX + EAX]
-
- // does current char match primary search char? if not, go back to the main loop
-
- CMP AL, SearchChar
- JNE @@FindNext
-
-@@Compare:
-
- // # of chars in Substr to compare
-
- MOV EDX, NumberOfChars
-
-@@CompareNext:
-
- // dec loop counter and check if we reached the end. If yes then we found it
-
- DEC EDX
- JL @@Found
-
- // get the chars from Str and Substr, if they are equal then continue comparing
-
- MOV AL, [ESI + EDX]
- CMP AL, [EDI + EDX]
- JE @@CompareNext
-
- // otherwise try the reverse case. If they still don't match go back to the Find loop
-
- MOV AL, [EBX + EAX + AnsiReOffset]
- CMP AL, [EDI + EDX]
- JNE @@FindNext
-
- // if they matched, continue comparing
-
- JMP @@CompareNext
-
-@@Found:
- // we found it, calculate the result
-
- MOV EAX, ESI
- POP ESI
- SUB EAX, ESI
-
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@NotFound:
-
- // not found it, clear the result
-
- XOR EAX, EAX
- POP ESI
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@IndexIsSmall:
-@@StrIsNull:
-
- // clear the result
-
- XOR EAX, EAX
-
-@@SubstrIsNull:
-@@Exit:
+function StrFind(const Substr, S: AnsiString; const Index: SizeInt): SizeInt;
+var
+ pos: SizeInt;
+begin
+ if (SubStr <> '') and (S <> '') then
+ begin
+ pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1));
+ if pos = 0 then
+ Result := 0
+ else
+ Result := Index + Pos - 1;
+ end
+ else
+ Result := 0;
end;
function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean;
@@ -2785,9 +2356,9 @@
Result := StrPrefixIndex(S, Prefixes) > -1;
end;
-function StrIndex(const S: AnsiString; const List: array of AnsiString): Integer;
+function StrIndex(const S: AnsiString; const List: array of AnsiString): SizeInt;
var
- I: Integer;
+ I: SizeInt;
begin
Result := -1;
for I := Low(List) to High(List) do
@@ -2800,12 +2371,12 @@
end;
end;
-function StrILastPos(const SubStr, S: AnsiString): Integer;
+function StrILastPos(const SubStr, S: AnsiString): SizeInt;
begin
Result := StrLastPos(StrUpper(SubStr), StrUpper(S));
end;
-function StrIPos(const SubStr, S: AnsiString): integer;
+function StrIPos(const SubStr, S: AnsiString): SizeInt;
begin
Result := Pos(StrUpper(SubStr), StrUpper(S));
end;
@@ -2815,7 +2386,7 @@
Result := StrIndex(S, List) > -1;
end;
-function StrLastPos(const SubStr, S: AnsiString): Integer;
+function StrLastPos(const SubStr, S: AnsiString): SizeInt;
var
Last, Current: PAnsiChar;
begin
@@ -2837,186 +2408,46 @@
end;
// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*)
+// (*) acts like (?)
-function StrMatch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
-asm
- // make sure that strings are not null
-
- TEST EAX, EAX
- JZ @@SubstrIsNull
-
- TEST EDX, EDX
- JZ @@StrIsNull
-
- // limit index to satisfy 1 <= index, and dec it
-
- DEC ECX
- JL @@IndexIsSmall
-
- // EBX will hold the case table, ESI pointer to Str, EDI pointer
- // to Substr and EBP # of chars in Substr to compare
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
- PUSH EBP
-
- // set the AnsiString pointers
-
- MOV ESI, EDX
- MOV EDI, EAX
-
- // save the Index in EDX
-
- MOV EDX, ECX
-
- // save the address of Str to compute the result
-
- PUSH ESI
-
- // temporary get the length of Substr and Str
-
- MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length
- MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length
-
- // dec the length of Substr because the first char is brought out of it
-
- DEC EBX
- JS @@NotFound
-
- // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2
-
- SUB ECX, EBX
- JLE @@NotFound
-
- SUB ECX, EDX
- JLE @@NotFound
-
- // # of chars in Substr to compare
-
- MOV EBP, EBX
-
- // point Str to Index'th char
-
- ADD ESI, EDX
-
- // load case map into EBX, and clear EAX & ECX
-
- LEA EBX, AnsiCaseMap
- XOR EAX, EAX
- XOR ECX, ECX
-
- // bring the first char out of the Substr and point Substr to the next char
-
- MOV CL, [EDI]
- INC EDI
-
- // lower case it
-
- MOV CL, [EBX + ECX]
-
-@@FindNext:
-
- // get the current char from Str into al
-
- MOV AL, [ESI]
- INC ESI
-
- // check the end of AnsiString
-
- TEST AL, AL
- JZ @@NotFound
-
-
- CMP CL, '*' // Wild Card?
- JE @@Compare
-
- CMP CL, '?' // Wild Card?
- JE @@Compare
-
- // lower case current char
-
- MOV AL, [EBX + EAX]
-
- // check if the current char matches the primary search char,
- // if not continue searching
-
- CMP AL, CL
- JNE @@FindNext
-
-@@Compare:
-
- // # of chars in Substr to compare }
-
- MOV EDX, EBP
-
-@@CompareNext:
-
- // dec loop counter and check if we reached the end. If yes then we found it
-
- DEC EDX
- JL @@Found
-
- // get the chars from Str and Substr, if they are equal then continue comparing
-
- MOV AL, [EDI + EDX] // char from Substr
-
- CMP AL, '*' // wild card?
- JE @@CompareNext
-
- CMP AL, '?' // wild card?
- JE @@CompareNext
-
- CMP AL, [ESI + EDX] // equal to PAnsiChar(Str)^ ?
- JE @@CompareNext
-
- MOV AL, [EBX + EAX + AnsiReOffset] // reverse case?
- CMP AL, [ESI + EDX]
- JNE @@FindNext // if still no, go back to the main loop
-
- // if they matched, continue comparing
-
- JMP @@CompareNext
-
-@@Found:
- // we found it, calculate the result
-
- MOV EAX, ESI
- POP ESI
- SUB EAX, ESI
-
- POP EBP
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@NotFound:
-
- // not found it, clear the result
-
- XOR EAX, EAX
- POP ESI
- POP EBP
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@IndexIsSmall:
-@@StrIsNull:
-
- // clear the result
-
- XOR EAX, EAX
-
-@@SubstrIsNull:
-@@Exit:
+function StrMatch(const Substr, S: AnsiString; Index: SizeInt): SizeInt;
+var
+ SI, SubI, SLen, SubLen: SizeInt;
+ SubC: AnsiChar;
+begin
+ SLen := Length(S);
+ SubLen := Length(Substr);
+ Result := 0;
+ if (Index > SLen) or (SubLen = 0) then
+ Exit;
+ while Index <= SLen do
+ begin
+ SubI := 1;
+ SI := Index;
+ while (SI <= SLen) and (SubI <= SubLen) do
+ begin
+ SubC := Substr[SubI];
+ if (SubC = '*') or (SubC = '?') or (SubC = S[SI]) then
+ begin
+ Inc(SI);
+ Inc(SubI);
+ end
+ else
+ Break;
+ end;
+ if SubI > SubLen then
+ begin
+ Result := Index;
+ Break;
+ end;
+ Inc(Index);
+ end;
end;
+
// Derived from "Like" by Michael Winter
-function StrMatches(const Substr, S: AnsiString; const Index: Integer): Boolean;
+function StrMatches(const Substr, S: AnsiString; const Index: SizeInt): Boolean;
var
StringPtr: PAnsiChar;
PatternPtr: PAnsiChar;
@@ -3124,9 +2555,9 @@
until False;
end;
-function StrNPos(const S, SubStr: AnsiString; N: Integer): Integer;
+function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt;
var
- I, P: Integer;
+ I, P: SizeInt;
begin
if N < 1 then
begin
@@ -3152,9 +2583,9 @@
end;
end;
-function StrNIPos(const S, SubStr: AnsiString; N: Integer): Integer;
+function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt;
var
- I, P: Integer;
+ I, P: SizeInt;
begin
if N < 1 then
begin
@@ -3180,9 +2611,9 @@
end;
end;
-function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): Integer;
+function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt;
var
- I: Integer;
+ I: SizeInt;
Test: AnsiString;
begin
Result := -1;
@@ -3197,167 +2628,33 @@
end;
end;
-function StrSearch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
-asm
- // make sure that strings are not null
-
- TEST EAX, EAX
- JZ @@SubstrIsNull
-
- TEST EDX, EDX
- JZ @@StrIsNull
-
- // limit index to satisfy 1 <= index, and dec it
-
- DEC ECX
- JL @@IndexIsSmall
-
- // ebp will hold # of chars in Substr to compare, esi pointer to Str,
- // edi pointer to Substr, ebx primary search char
-
- PUSH EBX
- PUSH ESI
- PUSH EDI
- PUSH EBP
-
- // set the AnsiString pointers
-
- MOV ESI, EDX
- MOV EDI, EAX
-
- // save the (Index - 1) in edx
-
- MOV EDX, ECX
-
- // save the address of Str to compute the result
-
- PUSH ESI
-
- // temporary get the length of Substr and Str
-
- MOV EBX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length
- MOV ECX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length
-
- // dec the length of Substr because the first char is brought out of it
-
- DEC EBX
- JS @@NotFound
-
- // # of positions in Str to look at = Length(Str) - Length(Substr) - Index - 2
-
- SUB ECX, EBX
- JLE @@NotFound
-
- SUB ECX, EDX
- JLE @@NotFound
-
- // point Str to Index'th char
-
- ADD ESI, EDX
-
- // # of chars in Substr to compare
-
- MOV EBP, EBX
-
- // clear EAX & ECX (working regs)
-
- XOR EAX, EAX
- XOR EBX, EBX
-
- // bring the first char out of the Substr, and
- // point Substr to the next char
-
- MOV BL, [EDI]
- INC EDI
-
- // jump into the loop
-
- JMP @@Find
-
-@@FindNext:
-
- // update the loop counter and check the end of AnsiString.
- // if we reached the end, Substr was not found.
-
- DEC ECX
- JL @@NotFound
-
-@@Find:
-
- // get current char from the AnsiString, and /point Str to the next one.
- MOV AL, [ESI]
- INC ESI
-
- // does current char match primary search char? if not, go back to the main loop
-
- CMP AL, BL
- JNE @@FindNext
-
- // otherwise compare SubStr
-
-@@Compare:
-
- // move # of char to compare into edx, edx will be our compare loop counter.
-
- MOV EDX, EBP
-
-@@CompareNext:
-
- // check if we reached the end of Substr. If yes we found it.
-
- DEC EDX
- JL @@Found
-
- // get last chars from Str and SubStr and compare them,
- // if they don't match go back to out main loop.
-
- MOV AL, [EDI+EDX]
- CMP AL, [ESI+EDX]
- JNE @@FindNext
-
- // if they matched, continue comparing
-
- JMP @@CompareNext
-
-@@Found:
- // we found it, calculate the result and exit.
-
- MOV EAX, ESI
- POP ESI
- SUB EAX, ESI
-
- POP EBP
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@NotFound:
- // not found it, clear result and exit.
-
- XOR EAX, EAX
- POP ESI
- POP EBP
- POP EDI
- POP ESI
- POP EBX
- RET
-
-@@IndexIsSmall:
-@@StrIsNull:
- // clear result and exit.
-
- XOR EAX, EAX
-
-@@SubstrIsNull:
-@@Exit:
+function StrSearch(const Substr, S: AnsiString; const Index: SizeInt): SizeInt;
+var
+ SP, SPI, SubP: PAnsiChar;
+ SLen: SizeInt;
+begin
+ SLen := Length(S);
+ if Index <= SLen then
+ begin
+ SP := PAnsiChar(S);
+ SubP := PAnsiChar(Substr);
+ SPI := SP;
+ Inc(SPI, Index);
+ SPI := StrPos(SPI, SubP);
+ if SPI <> nil then
+ Result := SPI - SP
+ else
+ Result := 0;
+ end
+ else
+ Result := 0;
end;
//=== String Extraction ======================================================
function StrAfter(const SubStr, S: AnsiString): AnsiString;
var
- P: Integer;
+ P: SizeInt;
begin
P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos
if P <= 0 then
@@ -3368,7 +2665,7 @@
function StrBefore(const SubStr, S: AnsiString): AnsiString;
var
- P: Integer;
+ P: SizeInt;
begin
P := StrFind(SubStr, S, 1);
if P <= 0 then
@@ -3380,8 +2677,8 @@
function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString;
var
- PosStart, PosEnd: Integer;
- L: Integer;
+ PosStart, PosEnd: SizeInt;
+ L: SizeInt;
begin
PosStart := Pos(Start, S);
PosEnd := ...
[truncated message content] |
|
From: <ou...@us...> - 2009-08-09 09:36:51
|
Revision: 2920
http://jcl.svn.sourceforge.net/jcl/?rev=2920&view=rev
Author: outchy
Date: 2009-08-09 09:36:43 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
Deletion of TXMLVarData type: the XML variant type now use the TVarData record fields vType and vAny.
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2009-08-07 10:02:54 UTC (rev 2919)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2009-08-09 09:36:43 UTC (rev 2920)
@@ -496,15 +496,6 @@
const Value: TVarData): Boolean; override;
end;
- TXMLVarData = packed record
- vType: TVarType;
- Reserved1: Word;
- Reserved2: Word;
- Reserved3: Word;
- XML: TJclSimpleXMLElem;
- Reserved4: Longint;
- end;
-
procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem);
function XMLCreate(const AXML: TJclSimpleXMLElem): Variant; overload;
function XMLCreate: Variant; overload;
@@ -1348,7 +1339,7 @@
if (N1 > 15) or (N2 > 15) then
Buf[J] := 0
else
- Buf[J] := N1 shl 4 + N2;
+ Buf[J] := (N1 shl 4) or N2;
Inc(J);
if J = cBufferSize - 1 then //Buffered write to speed up the process a little
begin
@@ -3590,8 +3581,8 @@
procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem);
begin
- TXMLVarData(ADest).vType := VarXML;
- TXMLVarData(ADest).XML := AXML;
+ TVarData(ADest).vType := VarXML;
+ TVarData(ADest).vAny := AXML;
end;
function XMLCreate(const AXML: TJclSimpleXMLElem): Variant;
@@ -3622,7 +3613,7 @@
ConversionString := TJclUTF16Stream.Create(StorageStream, False);
try
ConversionString.WriteBOM;
- TXMLVarData(Source).XML.SaveToStringStream(ConversionString, '', nil);
+ TJclSimpleXmlElem(Source.vAny).SaveToStringStream(ConversionString, '', nil);
ConversionString.Flush;
finally
ConversionString.Free;
@@ -3643,7 +3634,7 @@
{$ENDIF ~SUPPORTS_UNICODE}
try
ConversionString.WriteBOM;
- TXMLVarData(Source).XML.SaveToStringStream(ConversionString, '', nil);
+ TJclSimpleXmlElem(Source.vAny).SaveToStringStream(ConversionString, '', nil);
ConversionString.Flush;
finally
ConversionString.Free;
@@ -3661,7 +3652,7 @@
ConversionString := TJclUTF16Stream.Create(StorageStream, False);
try
ConversionString.WriteBOM;
- TXMLVarData(Source).XML.SaveToStringStream(ConversionString, '', nil);
+ TJclSimpleXmlElem(Source.vAny).SaveToStringStream(ConversionString, '', nil);
ConversionString.Flush;
finally
ConversionString.Free;
@@ -3686,7 +3677,7 @@
procedure TXMLVariant.Clear(var V: TVarData);
begin
V.vType := varEmpty;
- TXMLVarData(V).XML := nil;
+ V.vAny := nil;
end;
procedure TXMLVariant.Copy(var Dest: TVarData; const Source: TVarData;
@@ -3695,79 +3686,79 @@
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else
- with TXMLVarData(Dest) do
- begin
- vType := VarType;
- XML := TXMLVarData(Source).XML;
- end;
+ begin
+ Dest.vType := Source.vType;
+ Dest.vAny := Source.vAny;
+ end;
end;
function TXMLVariant.DoFunction(var Dest: TVarData; const V: TVarData;
const Name: string; const Arguments: TVarDataArray): Boolean;
var
- LXML: TJclSimpleXMLElem;
+ VXML, LXML: TJclSimpleXMLElem;
I, J, K: Integer;
begin
Result := False;
if (Length(Arguments) = 1) and (Arguments[0].vType in [vtInteger, vtExtended]) then
- with TXMLVarData(V) do
- begin
- K := Arguments[0].vInteger;
- J := 0;
+ begin
+ VXML := TJclSimpleXmlElem(V.VAny);
+ K := Arguments[0].vInteger;
+ J := 0;
- if K > 0 then
- for I := 0 to XML.Items.Count - 1 do
- if UpperCase(XML.Items[I].Name) = Name then
- begin
- Inc(J);
- if J = K then
- Break;
- end;
+ if K > 0 then
+ for I := 0 to VXML.Items.Count - 1 do
+ if UpperCase(VXML.Items[I].Name) = Name then
+ begin
+ Inc(J);
+ if J = K then
+ Break;
+ end;
- if (J = K) and (J < XML.Items.Count) then
+ if (J = K) and (J < VXML.Items.Count) then
+ begin
+ LXML := VXML.Items[J];
+ if LXML <> nil then
begin
- LXML := XML.Items[J];
- if LXML <> nil then
- begin
- Dest.vType := VarXML;
- TXMLVarData(Dest).XML := LXML;
- Result := True;
- end
- end;
+ Dest.vType := VarXML;
+ Dest.vAny := Pointer(LXML);
+ Result := True;
+ end
end;
+ end
end;
function TXMLVariant.GetProperty(var Dest: TVarData; const V: TVarData;
const Name: string): Boolean;
var
- LXML: TJclSimpleXMLElem;
+ VXML, LXML: TJclSimpleXMLElem;
lProp: TJclSimpleXMLProp;
begin
Result := False;
- with TXMLVarData(V) do
+ VXML := TJclSimpleXMLElem(V.VAny);
+ LXML := VXML.Items.ItemNamed[Name];
+ if LXML <> nil then
begin
- LXML := XML.Items.ItemNamed[Name];
- if LXML <> nil then
+ Dest.vType := VarXML;
+ Dest.vAny := Pointer(LXML);
+ Result := True;
+ end
+ else
+ begin
+ lProp := VXML.Properties.ItemNamed[Name];
+ if lProp <> nil then
begin
- Dest.vType := VarXML;
- TXMLVarData(Dest).XML := LXML;
+ VarDataFromOleStr(Dest, lProp.Value);
Result := True;
- end
- else
- begin
- lProp := XML.Properties.ItemNamed[Name];
- if lProp <> nil then
- begin
- VarDataFromOleStr(Dest, lProp.Value);
- Result := True;
- end;
end;
end;
end;
function TXMLVariant.IsClear(const V: TVarData): Boolean;
+var
+ VXML: TJclSimpleXMLElem;
begin
- Result := (TXMLVarData(V).XML = nil) or (TXMLVarData(V).XML.Items.Count = 0);
+ VXML := TJclSimpleXMLElem(V.VAny);
+ Result := (VXML = nil) or (VXML.Items.Count = 0);
end;
function TXMLVariant.SetProperty(const V: TVarData; const Name: string;
@@ -3783,27 +3774,25 @@
end;
var
- LXML: TJclSimpleXMLElem;
+ VXML, LXML: TJclSimpleXMLElem;
lProp: TJclSimpleXMLProp;
begin
Result := False;
- with TXMLVarData(V) do
+ VXML := TJclSimpleXmlElem(V.VAny);
+ LXML := VXML.Items.ItemNamed[Name];
+ if LXML = nil then
begin
- LXML := XML.Items.ItemNamed[Name];
- if LXML = nil then
+ lProp := VXML.Properties.ItemNamed[Name];
+ if lProp <> nil then
begin
- lProp := XML.Properties.ItemNamed[Name];
- if lProp <> nil then
- begin
- lProp.Value := GetStrValue;
- Result := True;
- end;
- end
- else
- begin
- LXML.Value := GetStrValue;
+ lProp.Value := GetStrValue;
Result := True;
end;
+ end
+ else
+ begin
+ LXML.Value := GetStrValue;
+ Result := True;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-07 10:03:06
|
Revision: 2919
http://jcl.svn.sourceforge.net/jcl/?rev=2919&view=rev
Author: outchy
Date: 2009-08-07 10:02:54 +0000 (Fri, 07 Aug 2009)
Log Message:
-----------
Delphi 2005 fails to compile the JCL with UNITVERSIONING turning on, this setting is now automatically disabled for this version of Delphi.
Modified Paths:
--------------
trunk/jcl/docs/Readme.html
trunk/jcl/docs/Readme.txt
trunk/jcl/install/JclInstall.pas
trunk/jcl/source/include/jcl.inc
trunk/jcl/source/include/jcl.template.inc
Modified: trunk/jcl/docs/Readme.html
===================================================================
--- trunk/jcl/docs/Readme.html 2009-08-07 09:53:33 UTC (rev 2918)
+++ trunk/jcl/docs/Readme.html 2009-08-07 10:02:54 UTC (rev 2919)
@@ -158,7 +158,7 @@
<ul>
- <li>Delphi 6 and Delphi 7;</li>
+ <li>Delphi 6, Delphi 7 and Delphi 2005;</li>
<li>C++Builder 6;</li>
Modified: trunk/jcl/docs/Readme.txt
===================================================================
--- trunk/jcl/docs/Readme.txt 2009-08-07 09:53:33 UTC (rev 2918)
+++ trunk/jcl/docs/Readme.txt 2009-08-07 10:02:54 UTC (rev 2919)
@@ -95,7 +95,7 @@
- Delphi 8.net (cf Installation notes).
Both supports (run time and design time):
- - Delphi 6 and Delphi 7;
+ - Delphi 6, Delphi 7 and Delphi 2005;
- C++Builder 6;
- Borland Developer Studio 2006 (Delphi for Win32, C++Builder for Win32,
Delphi.net and C#Builder personalities);
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2009-08-07 09:53:33 UTC (rev 2918)
+++ trunk/jcl/install/JclInstall.pas 2009-08-07 10:02:54 UTC (rev 2919)
@@ -21,7 +21,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -983,7 +983,9 @@
begin
AddOption(joJCLDefThreadSafe, [goChecked], Parent);
AddOption(joJCLDefDropObsoleteCode, [goChecked], Parent);
- AddOption(joJCLDefUnitVersioning, [goChecked], Parent);
+ if (Target.RadToolKind <> brBorlandDevStudio) or (Target.IDEVersionNumber <> 3) then
+ // Delphi 2005 has a compiler internal failure when compiling the JCL with UNITVERSIONING enabled
+ AddOption(joJCLDefUnitVersioning, [goChecked], Parent);
AddOption(joJCLDefMath, [goChecked], Parent);
AddOption(joJCLDefMathPrecSingle, [goRadioButton], joJCLDefMath);
Modified: trunk/jcl/source/include/jcl.inc
===================================================================
--- trunk/jcl/source/include/jcl.inc 2009-08-07 09:53:33 UTC (rev 2918)
+++ trunk/jcl/source/include/jcl.inc 2009-08-07 10:02:54 UTC (rev 2919)
@@ -348,6 +348,11 @@
{$DEFINE PUREPASCAL}
{$ENDIF CLR}
+// Delphi 2005 has a compiler internal failure when compiling the JCL with UNITVERSIONING enabled
+{$IFDEF DELPHI2005}
+ {$UNDEF UNITVERSIONING}
+{$ENDIF DELPHI2005}
+
{$IFDEF FPC}
{$DEFINE DEBUG_NO_TD32}
{$ENDIF FPC}
Modified: trunk/jcl/source/include/jcl.template.inc
===================================================================
--- trunk/jcl/source/include/jcl.template.inc 2009-08-07 09:53:33 UTC (rev 2918)
+++ trunk/jcl/source/include/jcl.template.inc 2009-08-07 10:02:54 UTC (rev 2919)
@@ -61,7 +61,7 @@
{.$DEFINE DROP_OBSOLETE_CODE}
-//Support for JclUnitVersioning.pas)
+//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward)
{.$DEFINE UNITVERSIONING}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-07 09:53:45
|
Revision: 2918
http://jcl.svn.sourceforge.net/jcl/?rev=2918&view=rev
Author: outchy
Date: 2009-08-07 09:53:33 +0000 (Fri, 07 Aug 2009)
Log Message:
-----------
added ignore mask on backup files.
Modified Paths:
--------------
trunk/thirdparty/svn_cleaner/SvnCleaner.xml
Property Changed:
----------------
trunk/jcl/source/include/
Property changes on: trunk/jcl/source/include
___________________________________________________________________
Modified: svn:ignore
- jclfpc.inc
jclc6.inc
jcld6.inc
jcld7.inc
jclcs1.inc
jcld8.inc
jcld9.inc
jcld10.inc
jcld11.inc
jcld12.inc
+ *~
*.bak
jclfpc.inc
jclc6.inc
jcld6.inc
jcld7.inc
jclcs1.inc
jcld8.inc
jcld9.inc
jcld10.inc
jcld11.inc
jcld12.inc
Modified: trunk/thirdparty/svn_cleaner/SvnCleaner.xml
===================================================================
--- trunk/thirdparty/svn_cleaner/SvnCleaner.xml 2009-08-07 08:23:23 UTC (rev 2917)
+++ trunk/thirdparty/svn_cleaner/SvnCleaner.xml 2009-08-07 09:53:33 UTC (rev 2918)
@@ -358,6 +358,8 @@
<setting path="" mask="include" recurse="no" dironly="yes">
<property name="svn:ignore">
+ <value>*~</value>
+ <value>*.bak</value>
<value>jclfpc.inc</value>
<value>jclc6.inc</value>
<value>jcld6.inc</value>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
49 messages has been excluded from this view by a project administrator.
