* implemented some usefull custom variant types * fixed memleak in uutlGenericsmaster
@@ -11,7 +11,7 @@ | |||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | |||
</SearchPaths> | |||
</CompilerOptions> | |||
<Files Count="26"> | |||
<Files Count="31"> | |||
<Item1> | |||
<Filename Value="uutlAlgorithm.pas"/> | |||
<UnitName Value="uutlAlgorithm"/> | |||
@@ -116,6 +116,26 @@ | |||
<Filename Value="uutlXmlHelper.pas"/> | |||
<UnitName Value="uutlXmlHelper"/> | |||
</Item26> | |||
<Item27> | |||
<Filename Value="uutlStored.pas"/> | |||
<UnitName Value="uutlStored"/> | |||
</Item27> | |||
<Item28> | |||
<Filename Value="uutlVariantObject.pas"/> | |||
<UnitName Value="uutlVariantObject"/> | |||
</Item28> | |||
<Item29> | |||
<Filename Value="uutlVariantProperty.pas"/> | |||
<UnitName Value="uutlVariantProperty"/> | |||
</Item29> | |||
<Item30> | |||
<Filename Value="uutlVariantEnum.pas"/> | |||
<UnitName Value="uutlVariantEnum"/> | |||
</Item30> | |||
<Item31> | |||
<Filename Value="uutlVariantSet.pas"/> | |||
<UnitName Value="uutlVariantSet"/> | |||
</Item31> | |||
</Files> | |||
<RequiredPkgs Count="2"> | |||
<Item1> | |||
@@ -11,7 +11,8 @@ uses | |||
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlCompression, uutlEmbeddedProfiler, uutlEnumerator, | |||
uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase, | |||
uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes, | |||
uutlXmlHelper, LazarusPackageIntf; | |||
uutlXmlHelper, uutlStored, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet, | |||
LazarusPackageIntf; | |||
implementation | |||
@@ -33,7 +33,7 @@ | |||
<PackageName Value="FCL"/> | |||
</Item3> | |||
</RequiredPackages> | |||
<Units Count="38"> | |||
<Units Count="40"> | |||
<Unit0> | |||
<Filename Value="tests.lpr"/> | |||
<IsPartOfProject Value="True"/> | |||
@@ -186,6 +186,14 @@ | |||
<Filename Value="uutlSetHelperTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit37> | |||
<Unit38> | |||
<Filename Value="uutlVariantEnumTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit38> | |||
<Unit39> | |||
<Filename Value="uutlVariantSetTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit39> | |||
</Units> | |||
</ProjectOptions> | |||
<CompilerOptions> | |||
@@ -15,9 +15,9 @@ uses | |||
uTestHelper, | |||
// units unter test | |||
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, | |||
uutlFilter, uutlGenerics, uutlInterfaces, uutlLinq, uutlListBase, uutlLogger, | |||
uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, uutlSetHelperTests; | |||
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, uutlFilter, uutlGenerics, uutlInterfaces, | |||
uutlLinq, uutlListBase, uutlLogger, uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, | |||
uutlSetHelperTests, uutlVariantEnumTest, uutlVariantSetTest; | |||
{$R *.res} | |||
@@ -4,21 +4,29 @@ | |||
<PathDelim Value="\"/> | |||
<Version Value="10"/> | |||
<BuildModes Active="Default"/> | |||
<Units Count="68"> | |||
<Units Count="82"> | |||
<Unit0> | |||
<Filename Value="tests.lpr"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="54" Y="12"/> | |||
<UsageCount Value="81"/> | |||
<EditorIndex Value="10"/> | |||
<CursorPos Y="5"/> | |||
<UsageCount Value="92"/> | |||
<Loaded Value="True"/> | |||
</Unit0> | |||
<Unit1> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="7"/> | |||
<TopLine Value="1003"/> | |||
<CursorPos Y="1021"/> | |||
<UsageCount Value="81"/> | |||
<TopLine Value="1897"/> | |||
<CursorPos X="3" Y="1900"/> | |||
<ExtraEditorCount Value="1"/> | |||
<ExtraEditor1> | |||
<EditorIndex Value="2"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="2008"/> | |||
<CursorPos Y="2043"/> | |||
</ExtraEditor1> | |||
<UsageCount Value="92"/> | |||
<Loaded Value="True"/> | |||
</Unit1> | |||
<Unit2> | |||
@@ -26,32 +34,32 @@ | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="11" Y="13"/> | |||
<UsageCount Value="81"/> | |||
<UsageCount Value="92"/> | |||
</Unit2> | |||
<Unit3> | |||
<Filename Value="..\uutlCommon.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="206"/> | |||
<CursorPos X="10" Y="225"/> | |||
<UsageCount Value="81"/> | |||
<EditorIndex Value="8"/> | |||
<TopLine Value="264"/> | |||
<CursorPos X="29" Y="283"/> | |||
<UsageCount Value="92"/> | |||
<Loaded Value="True"/> | |||
</Unit3> | |||
<Unit4> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="100"/> | |||
<CursorPos X="72" Y="113"/> | |||
<UsageCount Value="81"/> | |||
<Loaded Value="True"/> | |||
<UsageCount Value="92"/> | |||
</Unit4> | |||
<Unit5> | |||
<Filename Value="uutlListTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="3"/> | |||
<TopLine Value="573"/> | |||
<CursorPos Y="588"/> | |||
<UsageCount Value="81"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="50"/> | |||
<CursorPos X="3" Y="65"/> | |||
<UsageCount Value="92"/> | |||
</Unit5> | |||
<Unit6> | |||
<Filename Value="uutlQueueTests.pas"/> | |||
@@ -59,7 +67,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="250"/> | |||
<CursorPos X="49" Y="260"/> | |||
<UsageCount Value="81"/> | |||
<UsageCount Value="92"/> | |||
</Unit6> | |||
<Unit7> | |||
<Filename Value="uutlStackTests.pas"/> | |||
@@ -67,22 +75,23 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="246"/> | |||
<CursorPos X="24" Y="263"/> | |||
<UsageCount Value="81"/> | |||
<UsageCount Value="92"/> | |||
</Unit7> | |||
<Unit8> | |||
<Filename Value="uTestHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="4"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="3" Y="12"/> | |||
<UsageCount Value="81"/> | |||
<Loaded Value="True"/> | |||
<UsageCount Value="92"/> | |||
</Unit8> | |||
<Unit9> | |||
<Filename Value="..\uutlComparer.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="90" Y="6"/> | |||
<UsageCount Value="71"/> | |||
<EditorIndex Value="9"/> | |||
<TopLine Value="174"/> | |||
<CursorPos X="10" Y="190"/> | |||
<UsageCount Value="82"/> | |||
<Loaded Value="True"/> | |||
</Unit9> | |||
<Unit10> | |||
<Filename Value="..\uutlAlgorithm.pas"/> | |||
@@ -90,14 +99,14 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="138"/> | |||
<CursorPos Y="153"/> | |||
<UsageCount Value="81"/> | |||
<UsageCount Value="92"/> | |||
</Unit10> | |||
<Unit11> | |||
<Filename Value="uutlHashSetTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="32" Y="13"/> | |||
<UsageCount Value="81"/> | |||
<UsageCount Value="92"/> | |||
</Unit11> | |||
<Unit12> | |||
<Filename Value="uutlAlgorithmTests.pas"/> | |||
@@ -105,7 +114,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="72"/> | |||
<CursorPos X="43" Y="87"/> | |||
<UsageCount Value="80"/> | |||
<UsageCount Value="91"/> | |||
</Unit12> | |||
<Unit13> | |||
<Filename Value="uutlMapTests.pas"/> | |||
@@ -113,15 +122,15 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="206"/> | |||
<CursorPos X="66" Y="221"/> | |||
<UsageCount Value="79"/> | |||
<UsageCount Value="90"/> | |||
</Unit13> | |||
<Unit14> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="1"/> | |||
<TopLine Value="90"/> | |||
<CursorPos X="5" Y="105"/> | |||
<UsageCount Value="78"/> | |||
<EditorIndex Value="12"/> | |||
<TopLine Value="325"/> | |||
<CursorPos X="42" Y="341"/> | |||
<UsageCount Value="89"/> | |||
<Loaded Value="True"/> | |||
</Unit14> | |||
<Unit15> | |||
@@ -130,7 +139,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="615"/> | |||
<CursorPos X="34" Y="631"/> | |||
<UsageCount Value="78"/> | |||
<UsageCount Value="89"/> | |||
</Unit15> | |||
<Unit16> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
@@ -138,16 +147,15 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="17"/> | |||
<CursorPos X="13" Y="159"/> | |||
<UsageCount Value="74"/> | |||
<UsageCount Value="85"/> | |||
</Unit16> | |||
<Unit17> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="2"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="34"/> | |||
<CursorPos X="5" Y="40"/> | |||
<UsageCount Value="74"/> | |||
<Loaded Value="True"/> | |||
<UsageCount Value="85"/> | |||
</Unit17> | |||
<Unit18> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
@@ -155,7 +163,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="391"/> | |||
<CursorPos X="31" Y="417"/> | |||
<UsageCount Value="65"/> | |||
<UsageCount Value="76"/> | |||
</Unit18> | |||
<Unit19> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
@@ -163,13 +171,13 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="622"/> | |||
<CursorPos X="23" Y="650"/> | |||
<UsageCount Value="65"/> | |||
<UsageCount Value="76"/> | |||
</Unit19> | |||
<Unit20> | |||
<Filename Value="..\uutlTypes.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<UsageCount Value="65"/> | |||
<UsageCount Value="76"/> | |||
</Unit20> | |||
<Unit21> | |||
<Filename Value="..\uutlSyncObjs.pas"/> | |||
@@ -177,7 +185,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="241"/> | |||
<CursorPos X="20" Y="263"/> | |||
<UsageCount Value="59"/> | |||
<UsageCount Value="70"/> | |||
</Unit21> | |||
<Unit22> | |||
<Filename Value="..\uutlLogger.pas"/> | |||
@@ -185,7 +193,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="419"/> | |||
<CursorPos X="55" Y="434"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit22> | |||
<Unit23> | |||
<Filename Value="..\uutlXmlHelper.pas"/> | |||
@@ -193,7 +201,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="188"/> | |||
<CursorPos X="26" Y="203"/> | |||
<UsageCount Value="58"/> | |||
<UsageCount Value="69"/> | |||
</Unit23> | |||
<Unit24> | |||
<Filename Value="..\uutlStreamHelper.pas"/> | |||
@@ -201,7 +209,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="216"/> | |||
<CursorPos X="10" Y="241"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit24> | |||
<Unit25> | |||
<Filename Value="..\uutlCompression.pas"/> | |||
@@ -210,7 +218,7 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit25> | |||
<Unit26> | |||
<Filename Value="..\uutlEmbeddedProfiler.pas"/> | |||
@@ -219,7 +227,7 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit26> | |||
<Unit27> | |||
<Filename Value="..\uutlKeyCodes.pas"/> | |||
@@ -228,7 +236,7 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit27> | |||
<Unit28> | |||
<Filename Value="..\uutlMCF.pas"/> | |||
@@ -237,7 +245,7 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit28> | |||
<Unit29> | |||
<Filename Value="..\uutlSScanf.pas"/> | |||
@@ -246,7 +254,7 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit29> | |||
<Unit30> | |||
<Filename Value="..\uutlThreads.pas"/> | |||
@@ -255,14 +263,14 @@ | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="57"/> | |||
<UsageCount Value="68"/> | |||
</Unit30> | |||
<Unit31> | |||
<Filename Value="..\uutlEvent.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="11" Y="35"/> | |||
<UsageCount Value="56"/> | |||
<UsageCount Value="67"/> | |||
</Unit31> | |||
<Unit32> | |||
<Filename Value="..\uutlEventManager.pas"/> | |||
@@ -270,7 +278,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="246"/> | |||
<CursorPos X="39" Y="264"/> | |||
<UsageCount Value="56"/> | |||
<UsageCount Value="67"/> | |||
</Unit32> | |||
<Unit33> | |||
<Filename Value="..\uutlObservable.pas"/> | |||
@@ -278,7 +286,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="556"/> | |||
<CursorPos X="45" Y="572"/> | |||
<UsageCount Value="56"/> | |||
<UsageCount Value="67"/> | |||
</Unit33> | |||
<Unit34> | |||
<Filename Value="uutlObservableListTests.pas"/> | |||
@@ -286,7 +294,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="36"/> | |||
<CursorPos X="53" Y="52"/> | |||
<UsageCount Value="48"/> | |||
<UsageCount Value="59"/> | |||
</Unit34> | |||
<Unit35> | |||
<Filename Value="uutlObservableHashSetTests.pas"/> | |||
@@ -294,7 +302,7 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="46"/> | |||
<CursorPos X="25" Y="62"/> | |||
<UsageCount Value="28"/> | |||
<UsageCount Value="39"/> | |||
</Unit35> | |||
<Unit36> | |||
<Filename Value="uutlObservableMapTests.pas"/> | |||
@@ -302,360 +310,462 @@ | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="46"/> | |||
<CursorPos X="22" Y="51"/> | |||
<UsageCount Value="27"/> | |||
<UsageCount Value="38"/> | |||
</Unit36> | |||
<Unit37> | |||
<Filename Value="uutlSetHelperTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="44"/> | |||
<CursorPos X="64" Y="54"/> | |||
<UsageCount Value="24"/> | |||
<EditorIndex Value="11"/> | |||
<TopLine Value="45"/> | |||
<CursorPos Y="67"/> | |||
<UsageCount Value="35"/> | |||
<Loaded Value="True"/> | |||
</Unit37> | |||
<Unit38> | |||
<Filename Value="uutlVariantEnumTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="3"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="30"/> | |||
<CursorPos X="62" Y="34"/> | |||
<UsageCount Value="31"/> | |||
<Loaded Value="True"/> | |||
</Unit38> | |||
<Unit39> | |||
<Filename Value="..\uutlExceptions.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="21" Y="3"/> | |||
<UsageCount Value="32"/> | |||
</Unit38> | |||
<Unit39> | |||
</Unit39> | |||
<Unit40> | |||
<Filename Value="_uutlInterfaces.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="42" Y="6"/> | |||
<UsageCount Value="33"/> | |||
</Unit39> | |||
<Unit40> | |||
</Unit40> | |||
<Unit41> | |||
<Filename Value="uutlArrayTests.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="25" Y="38"/> | |||
<UsageCount Value="32"/> | |||
</Unit40> | |||
<Unit41> | |||
</Unit41> | |||
<Unit42> | |||
<Filename Value="..\uutlGenerics2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="1902"/> | |||
<CursorPos Y="1905"/> | |||
<UsageCount Value="7"/> | |||
</Unit41> | |||
<Unit42> | |||
</Unit42> | |||
<Unit43> | |||
<Filename Value="..\uutlCommon2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="15" Y="26"/> | |||
<UsageCount Value="7"/> | |||
</Unit42> | |||
<Unit43> | |||
</Unit43> | |||
<Unit44> | |||
<Filename Value="uutlInterfaces2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="49"/> | |||
<CursorPos X="35" Y="60"/> | |||
<UsageCount Value="7"/> | |||
</Unit43> | |||
<Unit44> | |||
</Unit44> | |||
<Unit45> | |||
<Filename Value="..\uutlAlgorithm2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="66"/> | |||
<CursorPos X="5" Y="93"/> | |||
<UsageCount Value="7"/> | |||
</Unit44> | |||
<Unit45> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
</Unit45> | |||
<Unit46> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="63"/> | |||
<CursorPos X="20" Y="75"/> | |||
<UsageCount Value="15"/> | |||
</Unit45> | |||
<Unit46> | |||
</Unit46> | |||
<Unit47> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlAlgorithm.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="48"/> | |||
<CursorPos X="45" Y="56"/> | |||
<UsageCount Value="7"/> | |||
</Unit46> | |||
<Unit47> | |||
</Unit47> | |||
<Unit48> | |||
<Filename Value="..\uutlEnumerator2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="126"/> | |||
<CursorPos X="22" Y="128"/> | |||
<UsageCount Value="6"/> | |||
</Unit47> | |||
<Unit48> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
</Unit48> | |||
<Unit49> | |||
<Filename Value="..\..\..\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="54"/> | |||
<CursorPos Y="69"/> | |||
<UsageCount Value="16"/> | |||
</Unit48> | |||
<Unit49> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/> | |||
</Unit49> | |||
<Unit50> | |||
<Filename Value="..\..\..\components\fptest\src\TestFramework.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="2243"/> | |||
<CursorPos Y="2258"/> | |||
<UsageCount Value="10"/> | |||
</Unit49> | |||
<Unit50> | |||
</Unit50> | |||
<Unit51> | |||
<Filename Value="..\internal_uutlInterfaces.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos Y="11"/> | |||
<UsageCount Value="6"/> | |||
</Unit50> | |||
<Unit51> | |||
</Unit51> | |||
<Unit52> | |||
<Filename Value="..\uutlUtils.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="46" Y="3"/> | |||
<UsageCount Value="7"/> | |||
</Unit51> | |||
<Unit52> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/> | |||
</Unit52> | |||
<Unit53> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="118"/> | |||
<CursorPos X="3" Y="143"/> | |||
<UsageCount Value="13"/> | |||
</Unit52> | |||
<Unit53> | |||
</Unit53> | |||
<Unit54> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlCommon.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="474"/> | |||
<CursorPos X="16" Y="500"/> | |||
<UsageCount Value="9"/> | |||
</Unit53> | |||
<Unit54> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/> | |||
</Unit54> | |||
<Unit55> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="202"/> | |||
<CursorPos X="10" Y="217"/> | |||
<UsageCount Value="8"/> | |||
</Unit54> | |||
<Unit55> | |||
</Unit55> | |||
<Unit56> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlSyncObjs.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="64"/> | |||
<CursorPos X="13" Y="76"/> | |||
<UsageCount Value="14"/> | |||
</Unit55> | |||
<Unit56> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/> | |||
</Unit56> | |||
<Unit57> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="83"/> | |||
<CursorPos X="4" Y="98"/> | |||
<UsageCount Value="14"/> | |||
</Unit56> | |||
<Unit57> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\func.inc"/> | |||
</Unit57> | |||
<Unit58> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\func.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="244"/> | |||
<CursorPos X="10" Y="259"/> | |||
<UsageCount Value="9"/> | |||
</Unit57> | |||
<Unit58> | |||
</Unit58> | |||
<Unit59> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlXmlHelper.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="29" Y="30"/> | |||
<UsageCount Value="8"/> | |||
</Unit58> | |||
<Unit59> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/> | |||
</Unit59> | |||
<Unit60> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="136"/> | |||
<CursorPos X="3" Y="151"/> | |||
<UsageCount Value="9"/> | |||
</Unit59> | |||
<Unit60> | |||
</Unit60> | |||
<Unit61> | |||
<Filename Value="..\uutlEmbeddedProfiler.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="19"/> | |||
</Unit60> | |||
<Unit61> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="190"/> | |||
<CursorPos X="23" Y="205"/> | |||
<UsageCount Value="14"/> | |||
</Unit61> | |||
<Unit62> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\objpash.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="248"/> | |||
<CursorPos X="8" Y="264"/> | |||
<UsageCount Value="15"/> | |||
</Unit62> | |||
<Unit63> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="40"/> | |||
<CursorPos X="3" Y="62"/> | |||
<UsageCount Value="12"/> | |||
</Unit62> | |||
<Unit63> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/> | |||
</Unit63> | |||
<Unit64> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="5662"/> | |||
<CursorPos X="8" Y="5677"/> | |||
<UsageCount Value="11"/> | |||
</Unit63> | |||
<Unit64> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\base.inc"/> | |||
</Unit64> | |||
<Unit65> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\base.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="448"/> | |||
<CursorPos X="12" Y="463"/> | |||
<UsageCount Value="11"/> | |||
</Unit64> | |||
<Unit65> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<EditorIndex Value="5"/> | |||
<TopLine Value="158"/> | |||
<CursorPos Y="185"/> | |||
<UsageCount Value="11"/> | |||
<Loaded Value="True"/> | |||
</Unit65> | |||
<Unit66> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<IsVisibleTab Value="True"/> | |||
<EditorIndex Value="8"/> | |||
<TopLine Value="3311"/> | |||
<CursorPos X="30" Y="3325"/> | |||
<UsageCount Value="11"/> | |||
<Loaded Value="True"/> | |||
<Filename Value="..\..\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="53"/> | |||
<CursorPos X="35" Y="66"/> | |||
<UsageCount Value="12"/> | |||
</Unit66> | |||
<Unit67> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFrameworkIfaces.pas"/> | |||
<EditorIndex Value="6"/> | |||
<Filename Value="..\..\fptest\src\TestFramework.pas"/> | |||
<EditorIndex Value="1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="2786"/> | |||
<CursorPos Y="2808"/> | |||
<UsageCount Value="14"/> | |||
<Loaded Value="True"/> | |||
</Unit67> | |||
<Unit68> | |||
<Filename Value="..\..\fptest\src\TestFrameworkIfaces.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="35"/> | |||
<CursorPos X="3" Y="51"/> | |||
<UsageCount Value="10"/> | |||
</Unit68> | |||
<Unit69> | |||
<Filename Value="..\uutlVariantEnum.pas"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="81"/> | |||
<CursorPos X="34" Y="105"/> | |||
<UsageCount Value="16"/> | |||
<Loaded Value="True"/> | |||
</Unit67> | |||
</Unit69> | |||
<Unit70> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\variants.pp"/> | |||
<EditorIndex Value="5"/> | |||
<UsageCount Value="14"/> | |||
<Loaded Value="True"/> | |||
</Unit70> | |||
<Unit71> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\varianth.inc"/> | |||
<EditorIndex Value="6"/> | |||
<TopLine Value="114"/> | |||
<CursorPos X="27" Y="136"/> | |||
<UsageCount Value="13"/> | |||
<Loaded Value="True"/> | |||
</Unit71> | |||
<Unit72> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\variant.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<UsageCount Value="11"/> | |||
</Unit72> | |||
<Unit73> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysconst.pp"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="107"/> | |||
<CursorPos X="3" Y="123"/> | |||
<UsageCount Value="11"/> | |||
</Unit73> | |||
<Unit74> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varutilh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="43"/> | |||
<CursorPos X="10" Y="59"/> | |||
<UsageCount Value="11"/> | |||
</Unit74> | |||
<Unit75> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\cvarutil.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="258"/> | |||
<CursorPos X="41" Y="272"/> | |||
<UsageCount Value="11"/> | |||
</Unit75> | |||
<Unit76> | |||
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varerror.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="2"/> | |||
<CursorPos X="3" Y="23"/> | |||
<UsageCount Value="11"/> | |||
</Unit76> | |||
<Unit77> | |||
<Filename Value="..\uutlVariantSet.pas"/> | |||
<TopLine Value="80"/> | |||
<CursorPos X="36" Y="95"/> | |||
<UsageCount Value="14"/> | |||
<Loaded Value="True"/> | |||
</Unit77> | |||
<Unit78> | |||
<Filename Value="..\uutlVariantObject.pas"/> | |||
<EditorIndex Value="1"/> | |||
<UsageCount Value="12"/> | |||
<Loaded Value="True"/> | |||
</Unit78> | |||
<Unit79> | |||
<Filename Value="..\uutlVariantProperty.pas"/> | |||
<EditorIndex Value="4"/> | |||
<TopLine Value="24"/> | |||
<UsageCount Value="12"/> | |||
<Loaded Value="True"/> | |||
</Unit79> | |||
<Unit80> | |||
<Filename Value="uutlVariantSetTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="2"/> | |||
<TopLine Value="17"/> | |||
<CursorPos Y="43"/> | |||
<UsageCount Value="22"/> | |||
<Loaded Value="True"/> | |||
</Unit80> | |||
<Unit81> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<IsVisibleTab Value="True"/> | |||
<EditorIndex Value="3"/> | |||
<TopLine Value="1726"/> | |||
<CursorPos X="16" Y="1749"/> | |||
<ExtraEditorCount Value="1"/> | |||
<ExtraEditor1> | |||
<IsVisibleTab Value="True"/> | |||
<EditorIndex Value="4"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="1480"/> | |||
<CursorPos X="85" Y="1507"/> | |||
</ExtraEditor1> | |||
<UsageCount Value="10"/> | |||
<Loaded Value="True"/> | |||
</Unit81> | |||
</Units> | |||
<OtherDefines Count="3"> | |||
<Define0 Value="UTL_ADVANCED_ENUMERATORS"/> | |||
<Define1 Value="UTL_NESTED_PROCVARS"/> | |||
<Define2 Value="UTL_ENUMERATORS"/> | |||
</OtherDefines> | |||
<JumpHistory Count="30" HistoryIndex="29"> | |||
<JumpHistory Count="28" HistoryIndex="27"> | |||
<Position1> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="139" TopLine="119"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1433" Column="6" TopLine="1416"/> | |||
</Position1> | |||
<Position2> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="143" TopLine="119"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="395" Column="20" TopLine="368"/> | |||
</Position2> | |||
<Position3> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="135" Column="35" TopLine="119"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1732" Column="18" TopLine="1723"/> | |||
</Position3> | |||
<Position4> | |||
<Filename Value="uutlListTest.pas"/> | |||
<Caret Line="612" Column="42" TopLine="594"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1733" Column="32" TopLine="1723"/> | |||
</Position4> | |||
<Position5> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="105" TopLine="89"/> | |||
<Filename Value="..\uutlVariantSet.pas"/> | |||
<Caret Line="16" Column="73"/> | |||
</Position5> | |||
<Position6> | |||
<Filename Value="uutlListTest.pas"/> | |||
<Caret Line="625" TopLine="610"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1733" Column="32" TopLine="1723"/> | |||
</Position6> | |||
<Position7> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<Caret Line="184" TopLine="158"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1727" Column="33" TopLine="1723"/> | |||
</Position7> | |||
<Position8> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3327" TopLine="3306"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="620" Column="31" TopLine="605"/> | |||
</Position8> | |||
<Position9> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3329" TopLine="3306"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="549" Column="57" TopLine="533"/> | |||
</Position9> | |||
<Position10> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3332" TopLine="3306"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="584" Column="50" TopLine="563"/> | |||
</Position10> | |||
<Position11> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3333" TopLine="3307"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="561" Column="36" TopLine="546"/> | |||
</Position11> | |||
<Position12> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3335" TopLine="3309"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="2044" Column="12" TopLine="2023"/> | |||
</Position12> | |||
<Position13> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
<Caret Line="3337" TopLine="3311"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="629" Column="23" TopLine="597"/> | |||
</Position13> | |||
<Position14> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<Caret Line="185" TopLine="158"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1917" Column="12" TopLine="1901"/> | |||
</Position14> | |||
<Position15> | |||
<Filename Value="uutlListTest.pas"/> | |||
<Caret Line="626" TopLine="610"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1926" Column="27" TopLine="1899"/> | |||
</Position15> | |||
<Position16> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="396" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1917" Column="17" TopLine="1901"/> | |||
</Position16> | |||
<Position17> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="397" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="2000" Column="3" TopLine="1997"/> | |||
</Position17> | |||
<Position18> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="398" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1971" Column="27" TopLine="1949"/> | |||
</Position18> | |||
<Position19> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="402" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1989" Column="13" TopLine="1968"/> | |||
</Position19> | |||
<Position20> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="403" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="561" Column="11" TopLine="553"/> | |||
</Position20> | |||
<Position21> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="405" TopLine="380"/> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1900" Column="3" TopLine="1897"/> | |||
</Position21> | |||
<Position22> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="407" TopLine="381"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1730" Column="2" TopLine="1723"/> | |||
</Position22> | |||
<Position23> | |||
<Filename Value="uutlListTest.pas"/> | |||
<Caret Line="627" TopLine="610"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1769" Column="17" TopLine="1758"/> | |||
</Position23> | |||
<Position24> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="103" TopLine="89"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1426" Column="25" TopLine="1410"/> | |||
</Position24> | |||
<Position25> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="104" TopLine="89"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="1774" Column="4" TopLine="1752"/> | |||
</Position25> | |||
<Position26> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="400" Column="28" TopLine="381"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="398" Column="15" TopLine="373"/> | |||
</Position26> | |||
<Position27> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="105" Column="24" TopLine="89"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="281" Column="34" TopLine="256"/> | |||
</Position27> | |||
<Position28> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="110" Column="29" TopLine="100"/> | |||
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
<Caret Line="273" Column="21" TopLine="261"/> | |||
</Position28> | |||
<Position29> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="106" TopLine="100"/> | |||
</Position29> | |||
<Position30> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Caret Line="113" Column="72" TopLine="100"/> | |||
</Position30> | |||
</JumpHistory> | |||
</ProjectSession> | |||
<Debugging> | |||
@@ -665,10 +775,13 @@ | |||
<InitialEnabled Value="False"/> | |||
</Item1> | |||
</BreakPointGroups> | |||
<Watches Count="1"> | |||
<Watches Count="2"> | |||
<Item1> | |||
<Expression Value="fCurrent"/> | |||
<Expression Value="TEnumVarData(v)"/> | |||
</Item1> | |||
<Item2> | |||
<Expression Value="TTestEnum(aSet)"/> | |||
</Item2> | |||
</Watches> | |||
</Debugging> | |||
</CONFIG> |
@@ -22,7 +22,7 @@ uses | |||
uutlGenerics; | |||
type | |||
TTestEnum = ( | |||
TSetHelperTestEnum = ( | |||
teTest0 = 0, | |||
teTest1 = 1, | |||
teTest2 = 2, | |||
@@ -32,8 +32,8 @@ type | |||
teTest8 = 8, | |||
teTest9 = 9 | |||
); | |||
TTestSet = set of TTestEnum; | |||
TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>; | |||
TSetHelperTestSet = set of TSetHelperTestEnum; | |||
TSetHelperTestSetH = specialize TutlSetHelper<TSetHelperTestEnum, TSetHelperTestSet>; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlSetHelperTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
@@ -42,31 +42,31 @@ procedure TutlSetHelperTests.proc_ToString; | |||
var | |||
str: String; | |||
begin | |||
str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]); | |||
str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]); | |||
AssertEquals('teTest0, teTest1, teTest2, teTest3, teTest4, teTest8', str); | |||
str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_'); | |||
str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_'); | |||
AssertEquals('teTest0_teTest1_teTest2_teTest3_teTest4_teTest8', str); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlSetHelperTests.proc_TryToSet; | |||
var | |||
s: TTestSet; | |||
s: TSetHelperTestSet; | |||
begin | |||
AssertTrue(TTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s)); | |||
AssertTrue(TSetHelperTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s)); | |||
AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s); | |||
AssertTrue(TTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s)); | |||
AssertTrue(TSetHelperTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s)); | |||
AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlSetHelperTests.proc_Compare; | |||
begin | |||
AssertEquals( 0, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
AssertEquals(-1, TTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
AssertEquals( 1, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2])); | |||
AssertEquals( 0, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
AssertEquals(-1, TSetHelperTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
AssertEquals( 1, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2])); | |||
end; | |||
initialization | |||
@@ -0,0 +1,94 @@ | |||
unit uutlVariantEnumTest; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, TestFramework, | |||
uutlVariantEnum; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantEnumTest = class(TTestCase) | |||
published | |||
procedure VariantToString; | |||
procedure VariantToEnum; | |||
procedure VariantToInt; | |||
end; | |||
implementation | |||
uses | |||
uutlGenerics; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TTestEnum = ( | |||
teTest2 = 2, | |||
teTest3 = 3, | |||
teTest5 = 5, | |||
teTest9 = 9 | |||
); | |||
TTestEnumH = specialize TutlEnumHelper<TTestEnum>; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantEnumTest/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnumTest.VariantToString; | |||
begin | |||
AssertEquals('2', String(VarMakeEnum(Ord(teTest2)))); | |||
AssertEquals('3', String(VarMakeEnum(Ord(teTest3)))); | |||
AssertEquals('5', String(VarMakeEnum(Ord(teTest5)))); | |||
AssertEquals('9', String(VarMakeEnum(Ord(teTest9)))); | |||
AssertEquals('teTest2', String(VarMakeEnum(Ord(teTest2), TTestEnumH))); | |||
AssertEquals('teTest3', String(VarMakeEnum(Ord(teTest3), TTestEnumH))); | |||
AssertEquals('teTest5', String(VarMakeEnum(Ord(teTest5), TTestEnumH))); | |||
AssertEquals('teTest9', String(VarMakeEnum(Ord(teTest9), TTestEnumH))); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnumTest.VariantToEnum; | |||
var | |||
e: TTestEnum; | |||
begin | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2)), e, true)); | |||
AssertEquals(Integer(teTest2), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3)), e, true)); | |||
AssertEquals(Integer(teTest3), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5)), e, true)); | |||
AssertEquals(Integer(teTest5), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9)), e, true)); | |||
AssertEquals(Integer(teTest9), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2), TTestEnumH), e, true)); | |||
AssertEquals(Integer(teTest2), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3), TTestEnumH), e, true)); | |||
AssertEquals(Integer(teTest3), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5), TTestEnumH), e, true)); | |||
AssertEquals(Integer(teTest5), Integer(e)); | |||
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9), TTestEnumH), e, true)); | |||
AssertEquals(Integer(teTest9), Integer(e)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnumTest.VariantToInt; | |||
begin | |||
// cause of a bug in FPC this test will always fail with a invalid cast exception | |||
AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2)))); | |||
AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3)))); | |||
AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5)))); | |||
AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9)))); | |||
AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2), TTestEnumH))); | |||
AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3), TTestEnumH))); | |||
AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5), TTestEnumH))); | |||
AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9), TTestEnumH))); | |||
end; | |||
initialization | |||
RegisterTest(TutlVariantEnumTest.Suite); | |||
end. | |||
@@ -0,0 +1,48 @@ | |||
unit uutlVariantSetTest; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, TestFramework, | |||
uutlVariantSet; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantSetTest = class(TTestCase) | |||
published | |||
procedure VariantToString; | |||
end; | |||
implementation | |||
uses | |||
uutlGenerics; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TTestEnum = ( | |||
teTest2 = 2, | |||
teTest3 = 3, | |||
teTest5 = 5, | |||
teTest9 = 9 | |||
); | |||
TTestSet = set of TTestEnum; | |||
TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantSetTest//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantSetTest.VariantToString; | |||
begin | |||
AssertEquals('teTest2, teTest3, teTest5, teTest9', String(VarMakeSet(TTestSet([teTest2, teTest3, teTest5, teTest9]), SizeOf(TTestSet), TTestSetH))); | |||
AssertEquals('teTest2, teTest5', String(VarMakeSet(TTestSet([teTest2, teTest5]), SizeOf(TTestSet), TTestSetH))); | |||
AssertEquals('teTest3', String(VarMakeSet(TTestSet([teTest3]), SizeOf(TTestSet), TTestSetH))); | |||
end; | |||
initialization | |||
RegisterTest(TutlVariantSetTest.Suite); | |||
end. | |||
@@ -80,7 +80,8 @@ end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean); | |||
begin | |||
utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem); | |||
if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then | |||
Finalize(aItem); | |||
FillByte(aItem, SizeOf(aItem), 0); | |||
end; | |||
@@ -90,7 +90,7 @@ function GetMicroTime (): QWord; | |||
function GetPlatformIdentitfier(): String; | |||
function utlRateLimited (const Reference: QWord; const Interval: QWord): boolean; | |||
procedure utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); | |||
function utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean; | |||
function utlFilterBuilder (): IutlFilterBuilder; | |||
implementation | |||
@@ -261,10 +261,11 @@ begin | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); | |||
function utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean; | |||
var | |||
o: TObject; | |||
begin | |||
result := true; | |||
case aTypeInfo^.Kind of | |||
tkClass: begin | |||
if (aFreeObject) then begin | |||
@@ -290,6 +291,9 @@ begin | |||
tkString: begin | |||
String(Obj) := ''; | |||
end; | |||
else | |||
result := false; | |||
end; | |||
end; | |||
@@ -0,0 +1,13 @@ | |||
unit uutlEnumVariant; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils; | |||
implementation | |||
end. | |||
@@ -453,6 +453,7 @@ type | |||
function TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean; | |||
function IndexOf (constref aKey: TKey): Integer; | |||
function Contains (constref aKey: TKey): Boolean; | |||
function Remove (constref aKey: TKey): Boolean; | |||
procedure Delete (constref aKey: TKey); | |||
procedure DeleteAt (const aIndex: Integer); | |||
procedure Clear; | |||
@@ -482,49 +483,153 @@ type | |||
constructor Create(const aValue, aExpectedType: String); | |||
end; | |||
generic TutlEnumHelper<T> = class | |||
TutlEnumHelperBaseClass = class of TutlEnumHelperBase; | |||
TutlEnumHelperBase = class | |||
public type | |||
TIntArray = array of Integer; | |||
TStringArray = array of String; | |||
private type | |||
TValuesMap = specialize TutlMap<string, TIntArray>; | |||
TNamesMap = specialize TutlMap<string, TStringArray>; | |||
private class var | |||
fValuesMap: TValuesMap; | |||
fNamesMap: TNamesMap; | |||
protected | |||
class procedure RegisterType (const aValues: TIntArray; const aNames: TStringArray); | |||
class procedure UnregisterType(); | |||
public | |||
class function ToString (const aValue: Integer; const aAllowOrd: Boolean = false): String; reintroduce; | |||
class function TryToEnum (const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean; | |||
class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): Integer; overload; | |||
class function ToEnum (const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean = false): Integer; overload; | |||
class function IntValues: TIntArray; | |||
class function Names: TStringArray; | |||
public | |||
class constructor Initialize; | |||
class destructor Finalize; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlEnumHelper<T> = class(TutlEnumHelperBase) | |||
public type | |||
TEnumType = T; | |||
TValueArray = array of T; | |||
TStringArray = array of String; | |||
private class var | |||
fTypeInfo: PTypeInfo; | |||
fValues: TValueArray; | |||
fNames: TStringArray; | |||
fIntValues: TIntArray; | |||
fTypeInfo: PTypeInfo; | |||
public | |||
class function ToString (aValue: T): String; reintroduce; | |||
class function TryToEnum (aStr: String; out aValue: T): Boolean; | |||
class function ToEnum (aStr: String): T; overload; | |||
class function ToEnum (aStr: String; const aDefault: T): T; overload; | |||
class function ToString (const aValue: T; const aAllowOrd: Boolean = false): String; reintroduce; | |||
class function TryToEnum (const aStr: String; out aValue: T; const aAllowOrd: Boolean = false): Boolean; | |||
class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): T; overload; | |||
class function ToEnum (const aStr: String; const aDefault: T; const aAllowOrd: Boolean = false): T; overload; | |||
class function Values: TValueArray; inline; | |||
class function IntValues: TIntArray; inline; | |||
class function Names: TStringArray; inline; | |||
class function TypeInfo: PTypeInfo; inline; | |||
class constructor Initialize; | |||
class destructor Finalize; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlSetHelperBase = class | |||
private type | |||
TEnumHelperMap = specialize TutlMap<string, TutlEnumHelperBaseClass>; | |||
private class var | |||
fEnumHelpers: TEnumHelperMap; | |||
private | |||
class function IsSet (const aSet; const aSize: Integer; const aValue: Integer): Boolean; | |||
class procedure SetValue (var aSet; const aSize: Integer; const aValue: Integer); | |||
class procedure ClearValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
protected | |||
class procedure RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass); | |||
class procedure UnregisterEnumHelper; | |||
public | |||
class function ToString( | |||
const aSet; | |||
const aSize: Integer; | |||
const aSeparator: String = ', '; | |||
const aAllowOrd: Boolean = false): String; reintroduce; | |||
class function TryToSet( | |||
const aStr: String; | |||
out aSet; | |||
const aSize: Integer; | |||
const aAllowOrd: Boolean = false): Boolean; | |||
class function TryToSet( | |||
const aStr: String; | |||
const aSeparator: String; | |||
out aSet; | |||
const aSize: Integer; | |||
const aAllowOrd: Boolean = false): Boolean; | |||
class function Compare( | |||
const aSet1; | |||
const aSet2; | |||
const aSize: Integer): Integer; | |||
class function EnumHelper: TutlEnumHelperBaseClass; | |||
class constructor Initialize; | |||
class destructor Finalize; | |||
end; | |||
TutlSetHelperBaseClass = class of TutlSetHelperBase; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlSetHelper<TEnum, TSet> = class | |||
generic TutlSetHelper<TEnum, TSet> = class(TutlSetHelperBase) | |||
public type | |||
TEnumHelper = specialize TutlEnumHelper<TEnum>; | |||
TEnumType = TEnum; | |||
TSetType = TSet; | |||
private | |||
class function IsSet (constref aSet: TSet; aEnum: TEnum): Boolean; | |||
class procedure SetValue (var aSet: TSet; aEnum: TEnum); | |||
class procedure ClearValue(var aSet: TSet; aEnum: TEnum); | |||
public | |||
class function ToString (const aValue: TSet; const aSeperator: String = ', '): String; reintroduce; | |||
class function TryToSet (const aStr: String; out aValue: TSet): Boolean; overload; | |||
class function TryToSet (const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; overload; | |||
class function ToSet (const aStr: String; const aDefault: TSet): TSet; overload; | |||
class function ToSet (const aStr: String): TSet; overload; | |||
class function Compare (const aSet1, aSet2: TSet): Integer; | |||
class function ToString( | |||
const aValue: TSet; | |||
const aSeparator: String = ', '; | |||
const aAllowOrd: Boolean = false): String; overload; | |||
class function TryToSet( | |||
const aStr: String; | |||
out aValue: TSet; | |||
const aAllowOrd: Boolean = false): Boolean; overload; | |||
class function TryToSet( | |||
const aStr: String; | |||
const aSeparator: String; | |||
out aValue: TSet; | |||
const aAllowOrd: Boolean = false): Boolean; overload; | |||
class function ToSet( | |||
const aStr: String; | |||
const aDefault: TSet; | |||
const aAllowOrd: Boolean = false): TSet; overload; | |||
class function ToSet( | |||
const aStr: String; | |||
const aAllowOrd: Boolean = false): TSet; overload; | |||
class function Compare( | |||
const aSet1, aSet2: TSet): Integer; overload; | |||
class constructor Initialize; | |||
class destructor Finalize; | |||
end; | |||
implementation | |||
@@ -1129,8 +1234,10 @@ end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); | |||
begin | |||
utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem); | |||
utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem); | |||
if not utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem) then | |||
Finalize(aItem.Key); | |||
if not utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem) then | |||
Finalize(aItem.Key); | |||
inherited Release(aItem, aFreeItem); | |||
end; | |||
@@ -1448,12 +1555,18 @@ begin | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlCustomMap.Delete(constref aKey: TKey); | |||
function TutlCustomMap.Remove(constref aKey: TKey): Boolean; | |||
var | |||
kvp: TKeyValuePair; | |||
begin | |||
kvp.Key := aKey; | |||
if not fHashSetRef.Remove(kvp) then | |||
result := fHashSetRef.Remove(kvp); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlCustomMap.Delete(constref aKey: TKey); | |||
begin | |||
if not Remove(aKey) then | |||
raise EInvalidOperation.Create('key not found'); | |||
end; | |||
@@ -1523,10 +1636,107 @@ begin | |||
inherited Create(Format('%s is not a %s', [aValue, aExpectedType])); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlEnumHelperBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class procedure TutlEnumHelperBase.RegisterType(const aValues: TIntArray; const aNames: TStringArray); | |||
begin | |||
fValuesMap.Add(ClassName, aValues); | |||
fNamesMap.Add (ClassName, aNames); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class procedure TutlEnumHelperBase.UnregisterType; | |||
begin | |||
fValuesMap.Remove(ClassName); | |||
fNamesMap.Remove(ClassName); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.ToString(const aValue: Integer; const aAllowOrd: Boolean = false): String; | |||
var | |||
i: Integer; | |||
iArr: TIntArray; | |||
sArr: TStringArray; | |||
begin | |||
iArr := fValuesMap[ClassName]; | |||
sArr := fNamesMap[ClassName]; | |||
for i := low(iArr) to high(iArr) do begin | |||
if (iArr[i] = aValue) then begin | |||
result := sArr[i]; | |||
exit; | |||
end; | |||
end; | |||
if aAllowOrd | |||
then result := IntToStr(aValue) | |||
else result := ''; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.TryToEnum(const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean; | |||
var | |||
i: Integer; | |||
iArr: TIntArray; | |||
sArr: TStringArray; | |||
begin | |||
iArr := fValuesMap[ClassName]; | |||
sArr := fNamesMap[ClassName]; | |||
for i := low(sArr) to high(sArr) do begin | |||
if (sArr[i] = aStr) then begin | |||
result := true; | |||
aValue := iArr[i]; | |||
exit; | |||
end; | |||
end; | |||
if aAllowOrd | |||
then result := TryStrToInt(aStr, aValue) | |||
else result := false; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aAllowOrd: Boolean): Integer; | |||
begin | |||
if not TryToEnum(aStr, result, aAllowOrd) then | |||
raise EConvertError.Create(aStr + ' is an unknown enum value'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean): Integer; | |||
begin | |||
if not TryToEnum(aStr, result, aAllowOrd) then | |||
result := aDefault; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.IntValues: TIntArray; | |||
begin | |||
result := fValuesMap[ClassName]; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelperBase.Names: TStringArray; | |||
begin | |||
result := fNamesMap[ClassName]; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class constructor TutlEnumHelperBase.Initialize; | |||
begin | |||
fNamesMap := TNamesMap.Create(true, true); | |||
fValuesMap := TValuesMap.Create(true, true); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class destructor TutlEnumHelperBase.Finalize; | |||
begin | |||
FreeAndNil(fNamesMap); | |||
FreeAndNil(fValuesMap); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlEnumHelper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.ToString(aValue: T): String; | |||
class function TutlEnumHelper.ToString(const aValue: T; const aAllowOrd: Boolean): String; | |||
begin | |||
{$Push} | |||
{$IOChecks OFF} | |||
@@ -1537,9 +1747,10 @@ begin | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean; | |||
class function TutlEnumHelper.TryToEnum(const aStr: String; out aValue: T; const aAllowOrd: Boolean): Boolean; | |||
var | |||
a: T; | |||
i: Integer; | |||
begin | |||
a := T(0); | |||
Result := false; | |||
@@ -1552,20 +1763,25 @@ begin | |||
Result := IOResult <> 106; | |||
{$Pop} | |||
if Result then | |||
aValue := a; | |||
aValue := a | |||
else if aAllowOrd then begin | |||
result := TryStrToInt(aStr, i); | |||
if result then | |||
aValue := T(i); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.ToEnum(aStr: String): T; | |||
class function TutlEnumHelper.ToEnum(const aStr: String; const aAllowOrd: Boolean): T; | |||
begin | |||
if not TryToEnum(aStr, result) then | |||
if not TryToEnum(aStr, result, aAllowOrd) then | |||
raise EEnumConvertException.Create(aStr, TypeInfo^.Name); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T; | |||
class function TutlEnumHelper.ToEnum(const aStr: String; const aDefault: T; const aAllowOrd: Boolean): T; | |||
begin | |||
if not TryToEnum(aStr, result) then | |||
if not TryToEnum(aStr, result, aAllowOrd) then | |||
result := aDefault; | |||
end; | |||
@@ -1575,6 +1791,12 @@ begin | |||
result := fValues; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.IntValues: TIntArray; | |||
begin | |||
result := fIntValues; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlEnumHelper.Names: TStringArray; | |||
begin | |||
@@ -1595,6 +1817,7 @@ var | |||
PName: PShortString; | |||
i: integer; | |||
en: T; | |||
sl: TStringList; | |||
begin | |||
{ | |||
See FPC Bug http://bugs.freepascal.org/view.php?id=27622 | |||
@@ -1613,97 +1836,142 @@ begin | |||
} | |||
tdEnum := GetTypeData(FTypeInfo); | |||
PName := @tdEnum^.NameList; | |||
SetLength(fValues, 0); | |||
SetLength(fNames, 0); | |||
i:= 0; | |||
while Length(PName^) > 0 do begin | |||
SetLength(fValues, i+1); | |||
SetLength(fNames, i+1); | |||
{ | |||
Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry. | |||
This can normally not be the same as a valid enum value, because it is in the same identifier | |||
namespace. However, with scoped enums we might have the same name for module and element, because | |||
the full identifier for the element would be TypeName.ElementName. | |||
In either case, the next PShortString will point to a zero-length string, and the loop is left | |||
with the last element being invalid (either empty or whatever value the unit-named element has). | |||
} | |||
fNames[i] := PName^; | |||
if TryToEnum(PName^, en) then | |||
fValues[i]:= en; | |||
sl := TStringList.Create; | |||
try | |||
while Length(PName^) > 0 do begin | |||
{ | |||
Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry. | |||
This can normally not be the same as a valid enum value, because it is in the same identifier | |||
namespace. However, with scoped enums we might have the same name for module and element, because | |||
the full identifier for the element would be TypeName.ElementName. | |||
In either case, the next PShortString will point to a zero-length string, and the loop is left | |||
with the last element being invalid (either empty or whatever value the unit-named element has). | |||
} | |||
sl.Add(PName^); | |||
if TryToEnum(PName^, en) then | |||
sl.Objects[sl.Count-1] := TObject({%H-}Pointer(PtrUInt(en))); | |||
inc(PByte(PName), Length(PName^) + 1); | |||
end; | |||
inc(i); | |||
inc(PByte(PName), Length(PName^) + 1); | |||
sl.Delete(sl.Count-1); // remove the EnumUnitName item | |||
SetLength(fValues, sl.Count); | |||
SetLength(fIntValues, sl.Count); | |||
SetLength(fNames, sl.Count); | |||
for i := 0 to sl.Count-1 do begin | |||
fNames[i] := sl[i]; | |||
fValues[i] := T(PtrUInt(sl.Objects[i])); | |||
fIntValues[i] := Integer(fValues[i]); | |||
end; | |||
finally | |||
FreeAndNil(sl); | |||
end; | |||
// remove the EnumUnitName item | |||
SetLength(fValues, High(fValues)); | |||
SetLength(fNames, High(fNames)); | |||
RegisterType(fIntValues, fNames); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlSetHelper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class destructor TutlEnumHelper.Finalize; | |||
begin | |||
Finalize(fNames); | |||
Finalize(fValues); | |||
Finalize(fIntValues); | |||
UnregisterType; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.IsSet(constref aSet: TSet; aEnum: TEnum): Boolean; | |||
//TutlSetHelperBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelperBase.IsSet(const aSet; const aSize: Integer; const aValue: Integer): Boolean; | |||
begin | |||
if (aValue >= 8*aSize) then | |||
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
result := ((PByte(@aSet)[aValue shr 3] and (1 shl (aValue and 7))) <> 0); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class procedure TutlSetHelperBase.SetValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
begin | |||
result := ((PByte(@aSet)[Integer(aEnum) shr 3] and (1 shl (Integer(aEnum) and 7))) <> 0); | |||
if (aValue >= 8*aSize) then | |||
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] or (1 shl (aValue and 7)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class procedure TutlSetHelper.SetValue(var aSet: TSet; aEnum: TEnum); | |||
class procedure TutlSetHelperBase.ClearValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
begin | |||
PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] or (1 shl (Integer(aEnum) and 7)); | |||
if (aValue >= 8*aSize) then | |||
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] and not (1 shl (aValue and 7)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class procedure TutlSetHelper.ClearValue(var aSet: TSet; aEnum: TEnum); | |||
class procedure TutlSetHelperBase.RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass); | |||
begin | |||
PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] and not (1 shl (Integer(aEnum) and 7)); | |||
fEnumHelpers.Add(ClassName, aHelper); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.ToString(const aValue: TSet; const aSeperator: String): String; | |||
class procedure TutlSetHelperBase.UnregisterEnumHelper; | |||
begin | |||
fEnumHelpers.Remove(ClassName); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelperBase.ToString(const aSet; const aSize: Integer; const aSeparator: String; | |||
const aAllowOrd: Boolean): String; | |||
var | |||
e: TEnum; | |||
i: Integer; | |||
h: TutlEnumHelperBaseClass; | |||
arr: TutlEnumHelperBase.TIntArray; | |||
begin | |||
h := EnumHelper; | |||
if not Assigned(h) then | |||
raise EInvalidOperation.Create('enum helper class is not set'); | |||
result := ''; | |||
for e in TEnumHelper.Values do begin | |||
if IsSet(aValue, e) then begin | |||
arr := h.IntValues; | |||
for i in arr do begin | |||
if IsSet(aSet, aSize, i) then begin | |||
if result > '' then | |||
result := result + aSeperator; | |||
result := result + TEnumHelper.ToString(e); | |||
result := result + aSeparator; | |||
result := result + h.ToString(i, aAllowOrd); | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet): Boolean; | |||
class function TutlSetHelperBase.TryToSet(const aStr: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean; | |||
begin | |||
result := TryToSet(aStr, ',', aValue); | |||
result := TryToSet(aStr, ',', aSet, aSize, aAllowOrd); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.TryToSet(const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; | |||
class function TutlSetHelperBase.TryToSet(const aStr: String; const aSeparator: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean; | |||
var | |||
i, j: Integer; | |||
i, j, e: Integer; | |||
s: String; | |||
e: TEnum; | |||
h: TutlEnumHelperBaseClass; | |||
begin | |||
if (aSeperator = '') then | |||
raise EArgumentException.Create('''aSeperator'' can not be empty'); | |||
if (aSeparator = '') then | |||
raise EArgumentException.Create('''aSeparator'' can not be empty'); | |||
h := EnumHelper; | |||
if not Assigned(h) then | |||
raise EInvalidOperation.Create('enum helper class is not set'); | |||
result := true; | |||
aValue := []; | |||
i := 1; | |||
j := 1; | |||
i := 1; | |||
j := 1; | |||
FillByte(aSet{%H-}, aSize, 0); | |||
while (i <= Length(aStr)) do begin | |||
if (Copy(aStr, i, Length(aSeperator)) = aSeperator) then begin | |||
if (Copy(aStr, i, Length(aSeparator)) = aSeparator) then begin | |||
s := Trim(copy(aStr, j, i - j)); | |||
if (s <> '') then begin | |||
result := result and TEnumHelper.TryToEnum(s, e); | |||
result := result and h.TryToEnum(s, e); | |||
if not result then | |||
exit; | |||
SetValue(aValue, e); | |||
j := i + Length(aSeperator); | |||
SetValue(aSet, aSize, e); | |||
j := i + Length(aSeparator); | |||
end; | |||
end; | |||
inc(i); | |||
@@ -1711,42 +1979,104 @@ begin | |||
s := Trim(copy(aStr, j, i - j)); | |||
if (s <> '') then begin | |||
result := result and TEnumHelper.TryToEnum(s, e); | |||
result := result and h.TryToEnum(s, e); | |||
if not result then | |||
exit; | |||
SetValue(aValue, e); | |||
end | |||
SetValue(aSet, aSize, e); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelperBase.Compare(const aSet1; const aSet2; const aSize: Integer): Integer; | |||
var | |||
e: Integer; | |||
h: TutlEnumHelperBaseClass; | |||
begin | |||
h := EnumHelper; | |||
if not Assigned(h) then | |||
raise EInvalidOperation.Create('enum helper class is not set'); | |||
result := 0; | |||
for e in h.IntValues do begin | |||
if IsSet(aSet1, aSize, e) and not IsSet(aSet2, aSize, e) then begin | |||
result := 1; | |||
break; | |||
end else | |||
if not IsSet(aSet1, aSize, e) and IsSet(aSet2, aSize, e) then begin | |||
result := -1; | |||
break; | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelperBase.EnumHelper: TutlEnumHelperBaseClass; | |||
begin | |||
result := fEnumHelpers[ClassName]; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class constructor TutlSetHelperBase.Initialize; | |||
begin | |||
fEnumHelpers := TEnumHelperMap.Create(true, true); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class destructor TutlSetHelperBase.Finalize; | |||
begin | |||
FreeAndNil(fEnumHelpers); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlSetHelper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.ToString(const aValue: TSet; const aSeparator: String; const aAllowOrd: Boolean): String; | |||
begin | |||
result := ToString(aValue, SizeOf(aValue), aSeparator, aAllowOrd); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean; | |||
begin | |||
result := TryToSet(aStr, ',', aValue, SizeOf(aValue), aAllowOrd); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.TryToSet(const aStr: String; const aSeparator: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean; | |||
begin | |||
result := TryToSet(aStr, aSeparator, aValue, SizeOf(aValue), aAllowOrd); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.ToSet(const aStr: String; const aDefault: TSet): TSet; | |||
class function TutlSetHelper.ToSet(const aStr: String; const aDefault: TSet; const aAllowOrd: Boolean): TSet; | |||
begin | |||
if not TryToSet(aStr, result) then | |||
if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then | |||
result := aDefault; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.ToSet(const aStr: String): TSet; | |||
class function TutlSetHelper.ToSet(const aStr: String; const aAllowOrd: Boolean): TSet; | |||
begin | |||
if not TryToSet(aStr, result) then | |||
if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then | |||
raise EEnumConvertException.CreateFmt('"%s" is an invalid value', [aStr]); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlSetHelper.Compare(const aSet1, aSet2: TSet): Integer; | |||
var | |||
e: TEnum; | |||
begin | |||
result := 0; | |||
for e in TEnumHelper.Values do begin | |||
if IsSet(aSet1, e) and not IsSet(aSet2, e) then begin | |||
result := 1; | |||
break; | |||
end else if not IsSet(aSet1, e) and IsSet(aSet2, e) then begin | |||
result := -1; | |||
break; | |||
end; | |||
end; | |||
result := Compare(aSet1, aSet2, SizeOf(aSet1)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class constructor TutlSetHelper.Initialize; | |||
begin | |||
RegisterEnumHelper(TEnumHelper); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class destructor TutlSetHelper.Finalize; | |||
begin | |||
UnregisterEnumHelper(); | |||
end; | |||
end. | |||
@@ -0,0 +1,496 @@ | |||
unit uutlStored; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, | |||
DOM, | |||
uutlMCF; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
IutlStored = interface(IUnknown) | |||
['{1AAA369A-B938-4430-AFAA-E4B5FD9D5A8D}'] | |||
function GetStoredCount(): Integer; // returns the number of stored values | |||
function GetStoredName (const aIndex: Integer): String; // returns the name of the stored value | |||
function GetStoredValue(const aIndex: Integer): Variant; // returns the stored value as string | |||
procedure SetStoredValue(const aIndex: Integer; const aValue: Variant); // set the stored value | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
IutlStoredWriter = interface(IUnknown) | |||
['{AE592B18-DDC2-408A-BB26-DAA24E2A7C34}'] | |||
procedure Write(constref aObj: IutlStored; const aStream: TStream); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
IutlStoredReader = interface(IUnknown) | |||
['{B596DCD9-5F34-45F9-82C7-790F5407E1E8}'] | |||
function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredWriter = class( | |||
TInterfacedObject | |||
, IutlStoredWriter) | |||
public { IutlStoredWriter } | |||
procedure Write(constref aObj: IutlStored; const aStream: TStream); virtual; | |||
constructor Create; virtual; | |||
public | |||
class function CreateWriter: IutlStoredWriter; | |||
end; | |||
TutlStoredWriterClass = class of TutlStoredWriter; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredReader = class( | |||
TInterfacedObject | |||
, IutlStoredReader) | |||
public { IutlStoredReader } | |||
function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; virtual; | |||
constructor Create; virtual; | |||
public | |||
class function CreateReader: IutlStoredReader; | |||
end; | |||
TutlStoredReaderClass = class of TutlStoredReader; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredXmlWriter = class(TutlStoredWriter) | |||
private | |||
fRootName: String; | |||
protected | |||
property RootName: String read fRootName write fRootName; | |||
procedure Write(constref aObj: IutlStored; const aElement: TDOMElement); virtual; | |||
public | |||
procedure Write(constref aObj: IutlStored; const aStream: TStream); override; | |||
constructor Create; override; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredXmlReader = class(TutlStoredReader) | |||
protected | |||
function CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored; virtual; | |||
procedure Read (constref aObj: IutlStored; const aElement: TDOMElement); virtual; | |||
public | |||
function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredMcfWriter = class(TutlStoredWriter) | |||
protected | |||
procedure Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection); virtual; | |||
procedure Write(constref aObj: IutlStored; const aSection: TutlMCFSection); virtual; | |||
public | |||
procedure Write(constref aObj: IutlStored; const aStream: TStream); override; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlStoredMcfReader = class(TutlStoredReader) | |||
private | |||
function TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean; | |||
protected | |||
function CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored; virtual; | |||
function ReadValue (constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant; virtual; | |||
procedure ReadSection (constref aObj: IutlStored; const aSection: TutlMCFSection); virtual; | |||
public | |||
function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override; | |||
end; | |||
implementation | |||
uses | |||
XMLWrite, XMLRead, variants, | |||
uutlXmlHelper, uutlSyncObjs; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredWriter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
begin | |||
// DUMMY | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
constructor TutlStoredWriter.Create; | |||
begin | |||
inherited Create; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlStoredWriter.CreateWriter: IutlStoredWriter; | |||
begin | |||
result := TutlStoredWriterClass(ClassType).Create; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredReader////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
begin | |||
result := false; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
constructor TutlStoredReader.Create; | |||
begin | |||
inherited Create; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlStoredReader.CreateReader: IutlStoredReader; | |||
begin | |||
result := TutlStoredReaderClass(ClassType).Create; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredXmlWriter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aElement: TDOMElement); | |||
var | |||
i, c: Integer; | |||
s: DOMString; | |||
v: Variant; | |||
vt: TVarType; | |||
intf: IUnknown; | |||
lock: IutlLockable; | |||
stored: IutlStored; | |||
begin | |||
if not Supports(aObj, IutlLockable, lock) then | |||
lock := nil; | |||
if Assigned(lock) then | |||
lock.Lock; | |||
try | |||
with TutlXmlHelper.Create(aElement) do begin | |||
c := aObj.GetStoredCount; | |||
for i := 0 to c-1 do begin | |||
s := DOMString(aObj.GetStoredName(i)); | |||
v := aObj.GetStoredValue(i); | |||
vt := VarType(v); | |||
case vt of | |||
varunknown: begin | |||
intf := IUnknown(v); | |||
if Supports(intf, IutlStored, stored) then | |||
Write(stored, AppendNode(s)); | |||
end; | |||
else | |||
SetAttribString(s, String(v)); | |||
end; | |||
end; | |||
end; | |||
finally | |||
if Assigned(lock) then | |||
lock.Unlock; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
var | |||
doc: TXMLDocument; | |||
root: TDOMElement; | |||
begin | |||
doc := TXMLDocument.Create; | |||
try | |||
root := doc.CreateElement(DOMString(fRootName)); | |||
doc.AppendChild(root); | |||
Write(aObj, root); | |||
WriteXMLFile(doc, aStream); | |||
finally | |||
FreeAndNil(doc); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
constructor TutlStoredXmlWriter.Create; | |||
begin | |||
inherited Create; | |||
fRootName := 'root'; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredXmlReader/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredXmlReader.CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored; | |||
begin | |||
result := nil; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredXmlReader.Read(constref aObj: IutlStored; const aElement: TDOMElement); | |||
var | |||
i, j: Integer; | |||
s: DOMString; | |||
v: Variant; | |||
vt: TVarType; | |||
intf: IUnknown; | |||
stored: IutlStored; | |||
attribs: TDOMNamedNodeMap; | |||
attrib: TDOMNode; | |||
el: TDOMElement; | |||
function TryFindStoredName(const aName: String; out aIndex: Integer): Boolean; | |||
var | |||
c, i: Integer; | |||
begin | |||
result := true; | |||
c := aObj.GetStoredCount; | |||
for i := 0 to c-1 do begin | |||
aIndex := i; | |||
if (aObj.GetStoredName(aIndex) = aName) then | |||
exit; | |||
end; | |||
aIndex := -1; | |||
result := false; | |||
end; | |||
begin | |||
with TutlXmlHelper.Create(aElement) do begin | |||
attribs := aElement.Attributes; | |||
for i := 0 to attribs.Length-1 do begin | |||
attrib := attribs.Item[i]; | |||
s := attrib.NodeName; | |||
v := attrib.TextContent; | |||
if not TryFindStoredName(String(s), j) then | |||
continue; | |||
aObj.SetStoredValue(j, v); | |||
end; | |||
for el in Nodes('') do begin | |||
s := el.NodeName; | |||
v := Unassigned; | |||
stored := nil; | |||
if TryFindStoredName(String(s), j) then begin | |||
v := aObj.GetStoredValue(j); | |||
vt := VarType(v); | |||
case vt of | |||
varunknown: begin | |||
intf := v; | |||
if not Supports(intf, IutlStored, stored) then | |||
stored := nil; | |||
end; | |||
else | |||
raise EInvalidOperation.Create('expected ' + String(s) + ' to be an stored object'); | |||
end; | |||
end else | |||
j := -1; | |||
if not Assigned(stored) then | |||
stored := CreateObject(aObj, el); | |||
if not Assigned(stored) then | |||
continue; | |||
Read(stored, el); | |||
aObj.SetStoredValue(j, stored); | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredXmlReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
var | |||
doc: TXMLDocument; | |||
p: Int64; | |||
begin | |||
p := aStream.Position; | |||
doc := TXMLDocument.Create; | |||
try try | |||
result := true; | |||
ReadXMLFile(doc, aStream); | |||
Read(aObj, (doc.FirstChild as TDOMElement)); | |||
except | |||
result := false; | |||
aStream.Position := p; | |||
end; | |||
finally | |||
FreeAndNil(doc); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredMcfWriter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection); | |||
begin | |||
Write(aObj, aParent.Section(aName)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aSection: TutlMCFSection); | |||
var | |||
lock: IutlLockable; | |||
i, c: Integer; | |||
s: String; | |||
v: Variant; | |||
vt: TVarType; | |||
intf: IUnknown; | |||
stored: IutlStored; | |||
begin | |||
if not Supports(aObj, IutlLockable, lock) then | |||
lock := nil; | |||
if Assigned(lock) then | |||
lock.Lock; | |||
try | |||
c := aObj.GetStoredCount; | |||
for i := 0 to c-1 do begin | |||
s := aObj.GetStoredName (i); | |||
v := aObj.GetStoredValue(i); | |||
vt := VarType(v); | |||
case vt of | |||
varunknown: begin | |||
intf := IUnknown(v); | |||
if Supports(intf, IutlStored, stored) then | |||
Write(stored, s, aSection); | |||
end; | |||
varboolean: | |||
aSection.SetBool(s, v); | |||
{$IFNDEF FPUNONE} | |||
varsingle, | |||
vardouble: | |||
aSection.SetFloat(s, v); | |||
{$ENDIF} | |||
vardecimal, | |||
varshortint, | |||
varbyte, | |||
varword, | |||
varlongword, | |||
varint64, | |||
varqword, | |||
varsmallint, | |||
varinteger: | |||
aSection.SetInt(s, v); | |||
else | |||
aSection.SetString(s, String(v)); | |||
end; | |||
end; | |||
finally | |||
if Assigned(lock) then | |||
lock.Unlock; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
var | |||
mcf: TutlMCFFile; | |||
begin | |||
mcf := TutlMCFFile.Create(nil); | |||
try | |||
Write(aObj, mcf); | |||
mcf.SaveToStream(aStream); | |||
finally | |||
FreeAndNil(mcf); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlStoredMcfReader/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredMcfReader.TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean; | |||
var | |||
c, i: Integer; | |||
begin | |||
result := true; | |||
c := aObj.GetStoredCount; | |||
for i := 0 to c-1 do begin | |||
aIndex := i; | |||
if (aObj.GetStoredName(aIndex) = aName) then | |||
exit; | |||
end; | |||
aIndex := -1; | |||
result := false; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredMcfReader.CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored; | |||
begin | |||
result := nil; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredMcfReader.ReadValue(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant; | |||
begin | |||
result := aParent.GetString(aName); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlStoredMcfReader.ReadSection(constref aObj: IutlStored; const aSection: TutlMCFSection); | |||
var | |||
i, j, c: Integer; | |||
s: String; | |||
v: Variant; | |||
vt: TVarType; | |||
intf: IUnknown; | |||
stored: IutlStored; | |||
begin | |||
c := aSection.ValueCount; | |||
for i := 0 to c-1 do begin | |||
s := aSection.ValueNameAt[i]; | |||
v := ReadValue(aObj, s, aSection); | |||
if (VarType(v) <> varempty) and TryFindStoredName(aObj, s, j) then | |||
aObj.SetStoredValue(j, v); | |||
end; | |||
c := aSection.SectionCount; | |||
for i := 0 to c-1 do begin | |||
s := aSection.SectionNameAt[i]; | |||
v := Unassigned; | |||
stored := nil; | |||
if TryFindStoredName(aObj, s, j) then begin | |||
v := aObj.GetStoredValue(j); | |||
vt := VarType(v); | |||
case vt of | |||
varunknown: begin | |||
intf := v; | |||
if not Supports(intf, IutlStored, stored) then | |||
stored := nil; | |||
end; | |||
else | |||
raise EInvalidOperation.Create('expected ' + s + ' to be an stored object'); | |||
end; | |||
end else | |||
j := -1; | |||
if not Assigned(stored) then | |||
stored := CreateObject(aObj, s, aSection); | |||
if not Assigned(stored) then | |||
continue; | |||
ReadSection(stored, aSection.Section(s)); | |||
aObj.SetStoredValue(j, stored); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlStoredMcfReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
var | |||
p: Int64; | |||
mcf: TutlMCFFile; | |||
begin | |||
p := aStream.Position; | |||
mcf := TutlMCFFile.Create(nil); | |||
try try | |||
result := true; | |||
mcf.LoadFromStream(aStream); | |||
ReadSection(aObj, mcf); | |||
except | |||
result := false; | |||
aStream.Position := p; | |||
end; | |||
finally | |||
FreeAndNil(mcf); | |||
end; | |||
end; | |||
end. | |||
@@ -0,0 +1,105 @@ | |||
unit uutlTypeInfo; | |||
{$mode objfpc}{$H+} | |||
{$ModeSwitch advancedrecords} | |||
interface | |||
uses | |||
Classes, SysUtils, variants; | |||
type | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantType = ( | |||
vtNull, | |||
// boolean | |||
vtBool, | |||
vtByteBool, | |||
vtWordBool, | |||
vtLongBool, | |||
// signed | |||
vtShortInt, | |||
vtSmallInt, | |||
vtLongInt, | |||
vtInt64, | |||
// unsigned | |||
vtByte, | |||
vtWord, | |||
vtLongWord, | |||
vtQuadWord, | |||
// floating point | |||
vtSingle, | |||
vtDouble, | |||
vtExtended, | |||
// characters | |||
vtAnsiChar, | |||
vtWideChar, | |||
// strings | |||
vtShortString, | |||
vtAnsiString, | |||
vtWideString, | |||
vtUnicodeString, | |||
vtUTF8String | |||
); | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariant = packed record | |||
private | |||
function GetVarType: TutlVariantType; | |||
public | |||
property VarType: TutlVariantType read GetVarType; | |||
private | |||
case fType: TutlVariantType of | |||
vtNull: (); | |||
// boolean | |||
vtBool: (fBool: Boolean); | |||
vtByteBool: (fByteBool: ByteBool); | |||
vtWordBool: (fWordBool: WordBool); | |||
vtLongBool: (fLongBool: LongBool); | |||
// signed | |||
vtShortInt: (fShortInt: ShortInt); | |||
vtSmallInt: (fSmallInt: SmallInt); | |||
vtLongInt: (fLongInt: LongInt); | |||
vtInt64: (fInt64: Int64); | |||
// unsigned | |||
vtByte: (fByte: Byte); | |||
vtWord: (fWord: Word); | |||
vtLongWord: (fLongWord: LongWord); | |||
vtQuadWord: (fQuadWord: QWord); | |||
// floating point | |||
vtSingle: (fFloat: Single); | |||
vtDouble: (fDouble: Double); | |||
vtExtended: (fExtended: Extended); | |||
// characters | |||
vtAnsiChar: (fAnsiChar: AnsiChar); | |||
vtWideChar: (fWideChar: WideChar); | |||
// strings | |||
vtShortString: (fShortString: ShortString); | |||
end; | |||
implementation | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariant//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlVariant.GetVarType: TutlVariantType; | |||
begin | |||
result := fType; | |||
end; | |||
end. | |||
@@ -0,0 +1,206 @@ | |||
unit uutlVariantEnum; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, variants, | |||
uutlGenerics; | |||
function VarEnum: TVarType; inline; | |||
function VarIsEnum(const aValue: Variant): Boolean; inline; | |||
function VarAsEnum(const aValue: Variant): Variant; inline; | |||
function VarMakeEnum(const aValue: Integer): Variant; | |||
function VarMakeEnum(const aValue: Integer; const aHelper: TutlEnumHelperBaseClass): Variant; | |||
function VarGetEnumHelper(const aValue: Variant): TutlEnumHelperBaseClass; | |||
implementation | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
PEnumVarData = ^TEnumVarData; | |||
TEnumVarData = packed record | |||
vType: TVarType; | |||
case Integer of | |||
0: ( | |||
vValue: Integer; | |||
vHelper: TutlEnumHelperBaseClass; | |||
); | |||
1: (vBytes : array[0..13] of byte); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantEnum = class(TCustomVariantType) | |||
public | |||
procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
procedure CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
procedure Clear (var V: TVarData); override; | |||
end; | |||
var | |||
VariantEnum: TutlVariantEnum; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarEnum: TVarType; | |||
begin | |||
result := VariantEnum.VarType; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarIsEnum(const aValue: Variant): Boolean; | |||
begin | |||
result := (VarType(aValue) = VariantEnum.VarType); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarAsEnum(const aValue: Variant): Variant; | |||
begin | |||
if not VarIsEnum(aValue) | |||
then VarCast(result, aValue, VarEnum) | |||
else result := aValue; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarMakeEnum(const aValue: Integer): Variant; | |||
begin | |||
result := VarMakeEnum(aValue, nil); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarMakeEnum(const aValue: Integer; const aHelper: TutlEnumHelperBaseClass): Variant; | |||
begin | |||
with PEnumVarData(@TVarData(result))^ do begin | |||
vType := VariantEnum.VarType; | |||
vValue := aValue; | |||
vHelper := aHelper; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarGetEnumHelper(const aValue: Variant): TutlEnumHelperBaseClass; | |||
begin | |||
if not VarIsEnum(aValue) then | |||
VarBadTypeError; | |||
result := PEnumVarData(@TVarData(aValue))^.vHelper; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantEnum/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnum.Cast(var Dest: TVarData; const Source: TVarData); | |||
function CheckValue(const aValue: Integer): Boolean; | |||
var | |||
i: Integer; | |||
begin | |||
with PEnumVarData(@Dest)^ do begin | |||
result := true; | |||
if not Assigned(vHelper) then | |||
exit; | |||
for i in vHelper.IntValues do | |||
if (i = aValue) then | |||
exit; | |||
result := false; | |||
end; | |||
end; | |||
var | |||
LSource: TVarData; | |||
begin | |||
if (Dest.vtype <> VariantEnum.VarType) then | |||
RaiseCastError; | |||
VarDataInit(LSource{%H-}); | |||
try | |||
VarDataCopyNoInd(LSource, Source); | |||
case LSource.vtype of | |||
varsmallint, | |||
varinteger, | |||
vardecimal, | |||
varshortint, | |||
varbyte, | |||
varword, | |||
varlongword, | |||
varint64, | |||
varqword: with PEnumVarData(@Dest)^ do begin | |||
if not CheckValue(Variant(LSource)) then | |||
RaiseCastError; | |||
vValue := Variant(Source); | |||
end; | |||
else | |||
with PEnumVarData(@Dest)^ do begin | |||
if not Assigned(vHelper) then | |||
RaiseCastError; | |||
if not vHelper.TryToEnum(Variant(LSource), vValue, true) then | |||
RaiseCastError; | |||
end; | |||
end; | |||
finally | |||
VarDataClear(LSource); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnum.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
var | |||
tmp: TVarData; | |||
begin | |||
if (Source.vtype <> VarType) then | |||
RaiseCastError; | |||
with PEnumVarData(@Source)^ do begin | |||
case aVarType of | |||
varolestr: | |||
if Assigned(vHelper) then begin | |||
VarDataFromOleStr(Dest, WideString(vHelper.ToString(vValue, true))); | |||
exit; | |||
end; | |||
varstring: | |||
if Assigned(vHelper) then begin | |||
VarDataFromStr(Dest, vHelper.ToString(vValue, true)); | |||
exit; | |||
end; | |||
end; | |||
VarDataInit(tmp{%H-}); | |||
try | |||
tmp.vtype := varinteger; | |||
tmp.vinteger := vValue; | |||
VarDataCastTo(Dest, tmp, aVarType); | |||
finally | |||
VarDataClear(tmp); | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnum.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
var | |||
src, dst: PEnumVarData; | |||
begin | |||
if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
RaiseInvalidOp; | |||
src := PEnumVarData(@Source); | |||
dst := PEnumVarData(@Dest); | |||
dst^.vType := src^.vType; | |||
dst^.vHelper := src^.vHelper; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantEnum.Clear(var V: TVarData); | |||
begin | |||
// DUMMY | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
initialization | |||
VariantEnum := TutlVariantEnum.Create; | |||
finalization | |||
FreeAndNil(VariantEnum); | |||
end. | |||
@@ -0,0 +1,149 @@ | |||
unit uutlVariantObject; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, variants; | |||
function VarObject: TVarType; inline; | |||
function VarIsObject(const aValue: Variant): Boolean; inline; | |||
function VarAsObject(const aValue: Variant): Variant; inline; | |||
operator :=(const aValue: TObject): Variant; inline; | |||
operator :=(const aValue: Variant): TObject; inline; | |||
implementation | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantObject = class(TCustomVariantType) | |||
public | |||
function IsClear (const V: TVarData): Boolean; override; | |||
procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
procedure CastTo (var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
procedure Clear (var V: TVarData); override; | |||
procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
public | |||
class function FromObject(const aObj: TObject): Variant; | |||
class function ToObject (const aVar: Variant): TObject; | |||
end; | |||
var | |||
VariantObject: TutlVariantObject; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarObject: TVarType; | |||
begin | |||
result := VariantObject.VarType; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarIsObject(const aValue: Variant): Boolean; | |||
begin | |||
result := (TVarData(aValue).vtype = VarObject); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarAsObject(const aValue: Variant): Variant; | |||
begin | |||
if not VarIsObject(aValue) | |||
then VarCast(result, aValue, VarObject) | |||
else result := aValue; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
operator := (const aValue: TObject): Variant; | |||
begin | |||
result := TutlVariantObject.FromObject(aValue); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
operator := (const aValue: Variant): TObject; | |||
begin | |||
result := TutlVariantObject.ToObject(aValue); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlVariantObject.IsClear(const V: TVarData): Boolean; | |||
begin | |||
result := (V.vpointer = nil); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantObject.Cast(var Dest: TVarData; const Source: TVarData); | |||
begin | |||
RaiseCastError; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantObject.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
var | |||
tmp: TVarData; | |||
begin | |||
if (Source.vtype <> VarType) then | |||
RaiseCastError; | |||
case aVarType of | |||
varolestr: | |||
VarDataFromOleStr(Dest, WideString(Format('$%p', [Source.vpointer]))); | |||
varstring: | |||
VarDataFromStr(Dest, Format('$%p', [Source.vpointer])); | |||
else | |||
VarDataInit(tmp{%H-}); | |||
try | |||
tmp.vtype := varqword; | |||
tmp.vqword := QWord(Source.vpointer); | |||
VarDataCastTo(Dest, tmp, aVarType); | |||
finally | |||
VarDataClear(tmp); | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantObject.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
begin | |||
if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
RaiseInvalidOp; | |||
Dest := Source; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantObject.Clear(var V: TVarData); | |||
begin | |||
V.vpointer := nil; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlVariantObject.FromObject(const aObj: TObject): Variant; | |||
begin | |||
TVarData(result).vtype := VarObject; | |||
TVarData(result).vpointer := aObj; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlVariantObject.ToObject(const aVar: Variant): TObject; | |||
var | |||
v: Variant; | |||
begin | |||
v := VarAsObject(aVar); | |||
result := TObject(TVarData(v).vpointer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
initialization | |||
VariantObject := TutlVariantObject.Create; | |||
finalization | |||
FreeAndNil(VariantObject); | |||
end. | |||
@@ -0,0 +1,157 @@ | |||
unit uutlVariantProperty; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, variants, typinfo; | |||
function VarProperty: TVarType; inline; | |||
function VarIsProperty(const aValue: Variant): Boolean; inline; | |||
function VarAsProperty(const aValue: Variant): Variant; inline; | |||
operator :=(const aValue: PPropInfo): Variant; | |||
operator :=(const aValue: Variant): PPropInfo; | |||
implementation | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantPropInfo = class(TCustomVariantType) | |||
public | |||
function IsClear (const V: TVarData): Boolean; override; | |||
procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
procedure CastTo (var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
procedure Clear (var V: TVarData); override; | |||
procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
public | |||
class function FromPropInfo(const aPropInfo: PPropInfo): Variant; | |||
class function ToPropInfo (const aValue: Variant): PPropInfo; | |||
end; | |||
var | |||
VariantProperty: TutlVariantPropInfo; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarProperty: TVarType; | |||
begin | |||
result := VariantProperty.VarType; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarIsProperty(const aValue: Variant): Boolean; | |||
begin | |||
result := (VarType(aValue) = VarProperty); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarAsProperty(const aValue: Variant): Variant; | |||
begin | |||
if not VarIsProperty(aValue) | |||
then VarCast(result, aValue, VarProperty) | |||
else result := aValue; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
operator := (const aValue: PPropInfo): Variant; | |||
begin | |||
result := TutlVariantPropInfo.FromPropInfo(aValue); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
operator := (const aValue: Variant): PPropInfo; | |||
begin | |||
result := TutlVariantPropInfo.ToPropInfo(aValue); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantProperty/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlVariantPropInfo.IsClear(const V: TVarData): Boolean; | |||
begin | |||
result := not Assigned(V.vpointer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantPropInfo.Cast(var Dest: TVarData; const Source: TVarData); | |||
begin | |||
RaiseCastError; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantPropInfo.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
begin | |||
if (Source.vtype <> VarType) then | |||
RaiseCastError; | |||
case aVarType of | |||
varolestr: | |||
if IsClear(Source) | |||
then VarDataFromOleStr(Dest, '') | |||
else VarDataFromOleStr(Dest, WideString(PPropInfo(Source.vpointer)^.Name)); | |||
varstring: | |||
if IsClear(Source) | |||
then VarDataFromStr(Dest, '') | |||
else VarDataFromStr(Dest, PPropInfo(Source.vpointer)^.Name); | |||
else | |||
RaiseCastError; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantPropInfo.Clear(var V: TVarData); | |||
begin | |||
if Assigned(V.vpointer) then begin | |||
Dispose(PPropInfo(V.vpointer)); | |||
V.vpointer := nil; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantPropInfo.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
begin | |||
if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
RaiseInvalidOp; | |||
Dest.vtype := Source.vtype; | |||
if Assigned(Source.vpointer) then begin | |||
if not Assigned(Dest.vpointer) then | |||
Dest.vpointer := New(PPropInfo); | |||
PPropInfo(Dest.vpointer)^ := PPropInfo(Source.vpointer)^; | |||
end else if Assigned(Dest.vpointer) then begin | |||
Dispose(PPropInfo(Dest.vpointer)); | |||
Dest.vpointer := nil; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlVariantPropInfo.FromPropInfo(const aPropInfo: PPropInfo): Variant; | |||
begin | |||
with TVarData(result) do begin | |||
vPointer := new(PPropInfo); | |||
vType := VarProperty; | |||
PPropInfo(vPointer)^ := aPropInfo^; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
class function TutlVariantPropInfo.ToPropInfo(const aValue: Variant): PPropInfo; | |||
begin | |||
with TVarData(aValue) do begin | |||
result := PPropInfo(vpointer); | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
initialization | |||
VariantProperty := TutlVariantPropInfo.Create; | |||
finalization | |||
FreeAndNil(VariantProperty); | |||
end. | |||
@@ -0,0 +1,172 @@ | |||
unit uutlVariantSet; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, variants, | |||
uutlGenerics; | |||
function VarSet: TVarType; inline; | |||
function VarIsSet(const aValue: Variant): Boolean; inline; | |||
function VarAsSet(const aValue: Variant): Variant; inline; | |||
function VarMakeSet(const aValue; const aSize: Integer): Variant; | |||
function VarMakeSet(const aValue; const aSize: Integer; const aHelper: TutlSetHelperBaseClass): Variant; | |||
function VarGetSetHelper(const aValue: Variant): TutlSetHelperBaseClass; | |||
implementation | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
PSetData = ^TSetData; | |||
TSetData = packed record | |||
Data: array[0..31] of Byte; | |||
Size: Integer; | |||
Helper: TutlSetHelperBaseClass; | |||
end; | |||
PSetVarData = ^TSetVarData; | |||
TSetVarData = packed record | |||
vType: TVarType; | |||
case Integer of | |||
0: (vData: PSetData); | |||
1: (vBytes: array[0..13] of Byte); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlVariantSet = class(TCustomVariantType) | |||
public | |||
procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
procedure CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
procedure Clear (var V: TVarData); override; | |||
end; | |||
var | |||
VariantSet: TutlVariantSet; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarSet: TVarType; | |||
begin | |||
result := VariantSet.VarType; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarIsSet(const aValue: Variant): Boolean; | |||
begin | |||
result := (VarType(aValue) = VarSet); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarAsSet(const aValue: Variant): Variant; | |||
begin | |||
if not VarIsSet(aValue) | |||
then VarCast(result, aValue, VarSet) | |||
else result := aValue; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarMakeSet(const aValue; const aSize: Integer): Variant; | |||
begin | |||
result := VarMakeSet(aValue, aSize, nil); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarMakeSet(const aValue; const aSize: Integer; const aHelper: TutlSetHelperBaseClass): Variant; | |||
begin | |||
with PSetVarData(@TVarData(result))^ do begin | |||
New (vData); | |||
FillByte(vData^.Data, SizeOf(vData^.Data), 0); | |||
Move (aValue, vData^.Data, aSize); | |||
vType := VarSet; | |||
vData^.Size := aSize; | |||
vData^.Helper := aHelper; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function VarGetSetHelper(const aValue: Variant): TutlSetHelperBaseClass; | |||
begin | |||
if not VarIsSet(aValue) then | |||
VarBadTypeError; | |||
with PSetVarData(@TVarData(aValue))^ do begin | |||
if not Assigned(vData) then | |||
VarInvalidOp; | |||
result := vData^.Helper; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//TutlVariantSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantSet.Cast(var Dest: TVarData; const Source: TVarData); | |||
begin | |||
if (Dest.vType <> VariantSet.VarType) then | |||
RaiseCastError; | |||
with PSetVarData(@Dest)^ do begin | |||
if not Assigned(vData^.Helper) then | |||
RaiseCastError; | |||
if not vData^.Helper.TryToSet(Variant(Source), vData^.Data, vData^.Size) then | |||
RaiseCastError; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantSet.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
begin | |||
if (Source.vtype <> VarType) then | |||
RaiseCastError; | |||
with PSetVarData(@Source)^ do begin | |||
if not Assigned(vData^.Helper) then | |||
RaiseCastError; | |||
case aVarType of | |||
varolestr: | |||
VarDataFromOleStr(Dest, WideString(vData^.Helper.ToString(vData^.Data, vData^.Size))); | |||
varstring: | |||
VarDataFromStr(Dest, vData^.Helper.ToString(vData^.Data, vData^.Size)); | |||
else | |||
RaiseCastError; | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantSet.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
var | |||
src, dst: PSetVarData; | |||
begin | |||
if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
RaiseInvalidOp; | |||
src := PSetVarData(@Source); | |||
dst := PSetVarData(@Dest); | |||
dst^.vType := src^.vType; | |||
if not Assigned(dst^.vData) then | |||
new(dst^.vData); | |||
dst^.vData^ := src^.vData^; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlVariantSet.Clear(var V: TVarData); | |||
begin | |||
with PSetVarData(@V)^ do begin | |||
if Assigned(vData) then begin | |||
Dispose(vData); | |||
vData := nil; | |||
end; | |||
end; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
initialization | |||
VariantSet := TutlVariantSet.Create; | |||
finalization | |||
FreeAndNil(VariantSet); | |||
end. | |||
@@ -217,13 +217,17 @@ end; | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
function TutlNodeEnumerator.MoveNext: Boolean; | |||
var | |||
c: Integer; | |||
begin | |||
c := fParent.ChildNodes.Count; | |||
repeat | |||
inc(fIndex) | |||
until (fIndex {%H-}>= fParent.ChildNodes.Count) | |||
or ( (fName = '') | |||
or (fName = fParent.ChildNodes[fIndex].NodeName)); | |||
result := (fIndex {%H-}< fParent.ChildNodes.Count); | |||
until (fIndex >= c) | |||
or ( (fParent.ChildNodes[fIndex] is TDOMElement) | |||
and ( (fName = '') | |||
or (fName = fParent.ChildNodes[fIndex].NodeName))); | |||
result := (fIndex < c); | |||
end; | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||